diff -Nru jimtcl-0.79+dfsg0/appveyor.yml jimtcl-0.81+dfsg0/appveyor.yml --- jimtcl-0.79+dfsg0/appveyor.yml 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/appveyor.yml 2021-11-27 23:06:54.000000000 +0000 @@ -1,10 +1,11 @@ -version: "0.78.0.{build}" +version: "0.80.0.{build}" +image: Visual Studio 2019 install: - cmd: set MSYSTEM=MINGW32 - cmd: C:\msys64\usr\bin\bash -lc "pacman --sync --noconfirm make mingw-w64-i686-gcc mingw-w64-i686-sqlite3" - cmd: cd C:\projects & mklink /D %APPVEYOR_PROJECT_NAME% %APPVEYOR_PROJECT_SLUG% & exit 0 build_script: - - cmd: C:\msys64\usr\bin\bash -lc "cd /c/projects/jimtcl; ./configure --full --ssl --with-ext='sqlite3 win32 zlib' --disable-docs" + - cmd: C:\msys64\usr\bin\bash -lc "cd /c/projects/jimtcl; ./configure --full --ssl --with-ext='sqlite3 win32 zlib' --disable-docs CFLAGS=-D__MINGW_USE_VC2005_COMPAT" - cmd: C:\msys64\usr\bin\bash -lc "cd /c/projects/jimtcl; make" test_script: - cmd: C:\msys64\usr\bin\bash -lc "cd /c/projects/jimtcl; make test" diff -Nru jimtcl-0.79+dfsg0/AUTHORS jimtcl-0.81+dfsg0/AUTHORS --- jimtcl-0.79+dfsg0/AUTHORS 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/AUTHORS 2021-11-27 23:06:54.000000000 +0000 @@ -11,7 +11,7 @@ some of the idea inside Jim are the fruit of long discussions inside the Tclers chat room. The feedback of the Tcl -comunity in general, and of the members of the Tcl Core Team, was +community in general, and of the members of the Tcl Core Team, was very important to avoid mistakes: I used the great experience of this people as a test for some of the ideas I put into Jim. Bad ideas tend to be demolished in no time by good engineers. @@ -21,12 +21,12 @@ - Jim locals were originally proposed by Miguel Sofer, I (SS) added the feature that make they similar to lexical scoped closures using capturing of the local variables value if no explicit - intialization is provided. + initialization is provided. - The [lmap] command is my (SS) design, but I incorporated inside the command an interesting idea of Donal K. Fellows that proposed that the [continue] command may be used to skip the accumulation of the - current-iteartion result, providing in one command the power of + current-iteration result, providing in one command the power of [map] and [filter] together. diff -Nru jimtcl-0.79+dfsg0/auto.def jimtcl-0.81+dfsg0/auto.def --- jimtcl-0.79+dfsg0/auto.def 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/auto.def 2021-11-27 23:06:54.000000000 +0000 @@ -1,7 +1,7 @@ # vim:se syn=tcl: # -define JIM_VERSION 79 +define JIM_VERSION 81 options-defaults { silent-rules 1 @@ -12,71 +12,171 @@ use local options { - utf8 => "include support for utf8-encoded strings" - lineedit=1 => "disable line editing" - references=1 => "disable support for references" - math => "include support for math functions" - ssl => "include ssl/tls support in the aio extension" - ipv6 => "include ipv6 support in the aio extension" - maintainer => {enable the [debug] command and JimPanic} - full => "Enable some optional features: ipv6, ssl, math, utf8, binary, oo, tree" - with-jim-shared shared => "build a shared library instead of a static library" - jim-regexp=1 => "prefer POSIX regex if over the the built-in (Tcl-compatible) regex" - docs=1 => "don't build or install the documentation" - docdir:path => "path to install docs (if built)" - random-hash => "randomise hash tables. more secure but hash table results are not predicable" + utf8 => "Include support for utf8-encoded strings" + lineedit=1 => "Disable line editing" + references=1 => "Disable support for references" + math => "Include support for math functions" + ssl => "Include ssl/tls support in the aio extension" + ipv6 => "Include ipv6 support in the aio extension" + maintainer => {Enable the [debug] command and JimPanic} + full => "Enable some optional features: ipv6, ssl, math, utf8, and some extensions (see --extinfo)" + allextmod => "Enable all non-default extensions as modules if prerequisites are found" + compat => "Enable some backward compatibility behaviour" + extinfo => "Show information about available extensions" + with-jim-shared shared => "Build a shared library instead of a static library" + jim-regexp=1 => "Prefer POSIX regex if over the the built-in (Tcl-compatible) regex" + docs=1 => "Don't build or install the documentation" + docdir:path => "Path to install docs (if built)" + random-hash => "Randomise hash tables. more secure but hash table results are not predicable" + coverage => "Build with code coverage support" with-jim-ext: {with-ext:"ext1,ext2,..."} => { - Specify additional jim extensions to include. - These are enabled by default: - - aio - ANSI I/O, including open and socket - eventloop - after, vwait, update - array - Tcl-compatible array command - clock - Tcl-compatible clock command - exec - Tcl-compatible exec command - file - Tcl-compatible file command - glob - Tcl-compatible glob command - history - Tcl access to interactive history - readdir - Required for glob - package - Package management with the package command - load - Load binary extensions at runtime with load or package - posix - Posix APIs including os.fork, os.uptime - regexp - Tcl-compatible regexp, regsub commands - signal - Signal handling - stdlib - Built-in commands including lassign, lambda, alias - syslog - System logging with syslog - tclcompat - Tcl compatible read, gets, puts, parray, case, ... - namespace - Tcl compatible namespace support - - These are disabled by default, but enabled by --full: - - oo - Jim OO extension - tree - OO tree structure, similar to tcllib ::struct::tree - binary - Tcl-compatible 'binary' command - tclprefix - Support for the tcl::prefix command - zlib - Interface to zlib - json - JSON encode/decode - - These are disabled unless explicitly enabled: - - readline - Interface to libreadline - rlprompt - Tcl wrapper around the readline extension - mk - Interface to Metakit - sqlite3 - Interface to sqlite3 - win32 - Interface to win32 + Specify additional Jim extensions to include. + Use --extinfo to show information about available extensions. } with-out-jim-ext: {without-ext:"default|ext1,ext2,..."} => { - Specify jim extensions to exclude. + Specify Jim extensions to exclude. If 'default' is given, the default extensions will not be added. } with-jim-extmod: {with-mod:"ext1,ext2,..."} => { - Specify jim extensions to build as separate modules (either C or Tcl). + Specify Jim extensions to build as separate modules (either C or Tcl). Note that not all extensions can be built as loadable modules. } # To help out openocd with automake install-jim=1 } +# Attributes and help for each supportted extensions +# tcl=Pure Tcl extension +# static=Can't be built as a module +# off=Off unless explicitly enabled or required by an enabled extension +# optional=Off by default, but selected by --full +# cpp=Is a C++ extension +global extdb + +foreach {mod attrs help} { + aio { static } {File and socket (networking) I/O} + array {} {Tcl-compatible array command} + binary { tcl optional } {Tcl-compatible binary command} + clock {} {Tcl-compatible clock command} + eventloop { static } {after, vwait, update} + exec { static } {Tcl-compatible exec command} + file {} {Tcl-compatible file command} + glob { tcl } {Tcl-compatible glob command} + history {} {Tcl access to interactive history} + interp {} {Support for child interpreters} + json { optional } {JSON decoder} + jsonencode { tcl off } {JSON encoder} + load { static } {Load binary extensions at runtime with load or package} + mk { cpp off } {Interface to metakit} + namespace { static } {Tcl compatible namespace support} + nshelper { tcl off } {} + oo { tcl } {Object Oriented class support} + pack {} {Low level binary pack and unpack} + package { static } {Package management with the package command} + posix {} {Posix APIs including os.fork, os.uptime} + readdir {} {Read the contents of a directory (used by glob)} + readline { off } {Interface to libreadline} + redis { off } {Client interface to redis database} + regexp {} {Tcl-compatible regexp, regsub commands} + rlprompt { tcl off } {readline-based REPL} + sdl { off } {SDL graphics interface} + signal { static } {Signal handling} + sqlite3 { off } {Interface to sqlite3 database} + stdlib { tcl static } {Built-in commands including lambda, stacktrace and some dict subcommands} + syslog {} {System logging with syslog} + tclcompat { tcl static } {Tcl compatible read, gets, puts, parray, case, ...} + tclprefix { optional } {Support for the tcl::prefix command} + tree { tcl } {OO tree structure, similar to tcllib ::struct::tree} + win32 { off } {Interface to win32} + zlib { optional } {zlib compression interface} +} { + dict set extdb attrs $mod $attrs + dict set extdb help $mod $help +} + +if {[opt-bool extinfo]} { + use text-formatting + use help + use_pager + nl + p { + Jim Tcl is very modular and many extensions can be selectively + enabled (--with-ext) or disabled (--without-ext). + Many extensions may be statically compiled into Jim Tcl or built as loadable modules (--with-mod). + This includes both C extensions and Tcl extensions. + } + + # collect extension info + set attrs [dict get $extdb attrs] + set info {} + foreach mod [dict keys $attrs] { + set help [dict get $extdb help $mod] + if {$help ne ""} { + if {"off" in [dict get $attrs $mod]} { + set a off + } elseif {"optional" in [dict get $attrs $mod]} { + set a optional + } else { + set a default + } + dict set info $mod [list $a $help] + } + } + + proc showmods {heading info type} { + p $heading + foreach mod [dict keys $info] { + lassign [dict get $info $mod] a help + if {$a eq $type} { + puts "[format %10s $mod] - $help" + } + } + } + showmods "These extensions are enabled by default:" $info default + nl + showmods "These are disabled by default, but enabled by --full:" $info optional + nl + showmods { + These are disabled unless explicitly enabled or --allextmod is selected and + the prerequisites are met: + } $info off + exit 0 +} + +# Additional information about certain extensions +# dep=list of extensions which are required for this extension +# check=[expr] expression to evaluate to determine if the extension can be used +# libdep=list of 'define' symbols for dependent libraries +# pkg-config=name1 ?args?, name2* ?args? | name3 ?args? +# Any set of packages from the alternates is acceptable (e.g. name1 and name2, or name3) +# If the pkgname has a * appended, it is optional (so name1 without name2 is OK) +# The optional args are pkg-config specifications (e.g. name1 >= 1.3.4) +dict set extdb info { + binary { dep pack } + exec { check {([have-feature vfork] && [have-feature waitpid]) || [have-feature system]} } + glob { dep readdir } + load { check {[have-feature dlopen-compat] || [cc-check-function-in-lib dlopen dl]} libdep lib_dlopen } + mk { check {[check-metakit]} libdep lib_mk } + namespace { dep nshelper } + json { dep jsonencode extrasrcs jsmn/jsmn.c } + posix { check {[have-feature waitpid]} } + readdir { check {[have-feature opendir]} } + readline { pkg-config readline check {[cc-check-function-in-lib readline readline]} libdep lib_readline} + rlprompt { dep readline } + tree { dep oo } + sdl { pkg-config {SDL2_gfx, SDL2_ttf* | SDL_gfx} check false } + signal { check {[have-feature sigaction]} } + sqlite3 { pkg-config sqlite3 check {[cc-check-function-in-lib sqlite3_prepare_v2 sqlite3]} libdep lib_sqlite3_prepare_v2 } + redis { pkg-config hiredis check {[cc-check-function-in-lib redisConnect hiredis]} libdep lib_redisConnect } + zlib { pkg-config zlib check {[cc-check-function-in-lib deflate z]} libdep lib_deflate } + syslog { check {[have-feature syslog]} } + tree { dep oo } + win32 { check {[have-feature windows]} } +} + + +set warnings {} + # Save the user-specified LIBS # We add detected libs to LDLIBS explicitly set LIBS [get-define LIBS] @@ -98,9 +198,33 @@ if {[cctest -cflags -fno-asynchronous-unwind-tables]} { define-append CCOPTS -fno-asynchronous-unwind-tables } +if {[opt-bool coverage]} { + if {[cctest -link 1 -cflags --coverage]} { + # When using coverage, disable ccache and compiler optimisation + define CCACHE "" + define-append CCOPTS --coverage -O0 + define-append LDFLAGS --coverage + define COVERAGE 1 + if {[cc-check-progs gcovr]} { + define COVERAGE_TOOL gcovr + } elseif {[cc-check-progs lcov] && [cc-check-progs genhtml]} { + define COVERAGE_TOOL lcov + } else { + define COVERAGE_TOOL gcov + lappend warnings "Note: Neither lcov nor gcovr is available, falling back to gcov" + } + } else { + lappend warnings "Warning: --coverage specified, but compiler does not support --coverage" + } +} -cc-check-includes sys/time.h sys/socket.h netinet/in.h arpa/inet.h netdb.h -cc-check-includes sys/un.h dlfcn.h unistd.h dirent.h crt_externs.h +cc-check-includes time.h sys/time.h sys/socket.h netinet/in.h arpa/inet.h netdb.h +cc-check-includes util.h pty.h sys/un.h dlfcn.h unistd.h dirent.h crt_externs.h execinfo.h + +# Check sizeof time_t so we can warn on non-Y2038 compliance +cc-with {-includes time.h} { + cc-check-sizeof time_t +} define LDLIBS "" @@ -125,6 +249,9 @@ if {[cc-check-function-in-lib backtrace execinfo]} { define-append LDLIBS [get-define lib_backtrace] } +if {[cc-check-function-in-lib openpty util]} { + define-append LDLIBS [get-define lib_openpty] +} if {[cc-check-functions sysinfo]} { cc-with {-includes sys/sysinfo.h} { @@ -169,7 +296,7 @@ # Find some tools cc-check-tools ar ranlib strip -define tclsh [info nameofexecutable] +define tclsh [quote-if-needed [info nameofexecutable]] # We only support silent-rules for GNU Make define NO_SILENT_RULES @@ -306,6 +433,10 @@ msg-result "Enabling references" define JIM_REFERENCES } +if {[opt-bool compat]} { + msg-result "Enabling compatibility mode" + define JIM_COMPAT +} if {[opt-bool shared with-jim-shared]} { msg-result "Building shared library" } else { @@ -324,78 +455,6 @@ define JIM_RANDOMISE_HASH [opt-bool random-hash] define docdir [opt-str docdir o {${prefix}/docs/jim}] -# Attributes of the extensions -# tcl=Pure Tcl extension -# static=Can't be built as a module -# off=Off unless explicitly enabled -# optional=Off by default, but selected by --full -# cpp=Is a C++ extension -global extdb -dict set extdb attrs { - aio { static } - array {} - binary { tcl optional } - clock {} - eventloop { static } - exec { static } - file {} - glob { tcl } - history {} - interp { } - json { optional } - jsonencode { tcl optional } - load { static } - mk { cpp off } - namespace { static } - nshelper { tcl optional } - oo { tcl } - pack {} - package { static } - posix {} - readdir {} - readline { off } - regexp {} - rlprompt { tcl off } - sdl { off } - signal { static } - sqlite3 { off } - zlib { optional } - stdlib { tcl static } - syslog {} - tclcompat { tcl static } - tclprefix { optional } - tree { tcl } - win32 { off } -} - -# Additional information about certain extensions -# dep=list of extensions which are required for this extension -# check=[expr] expression to evaluate to determine if the extension can be used -# libdep=list of 'define' symbols for dependent libraries -dict set extdb info { - binary { dep pack } - exec { check {([have-feature vfork] && [have-feature waitpid]) || [have-feature system]} } - glob { dep readdir } - load { check {[have-feature dlopen-compat] || [cc-check-function-in-lib dlopen dl]} libdep lib_dlopen } - mk { check {[check-metakit]} libdep lib_mk } - namespace { dep nshelper } - json { dep jsonencode extrasrcs jsmn/jsmn.c } - posix { check {[have-feature waitpid]} } - readdir { check {[have-feature opendir]} } - readline { pkg-config readline check {[cc-check-function-in-lib readline readline]} libdep lib_readline} - rlprompt { dep readline } - tree { dep oo } - sdl { pkg-config SDL_gfx check {[cc-check-function-in-lib SDL_SetVideoMode SDL] && [cc-check-function-in-lib rectangleRGBA SDL_gfx]} - libdep {lib_SDL_SetVideoMode lib_rectangleRGBA} - } - signal { check {[have-feature sigaction]} } - sqlite3 { pkg-config sqlite3 check {[cc-check-function-in-lib sqlite3_prepare_v2 sqlite3]} libdep lib_sqlite3_prepare_v2 } - zlib { pkg-config zlib check {[cc-check-function-in-lib deflate z]} libdep lib_deflate } - syslog { check {[have-feature syslog]} } - tree { dep oo } - win32 { check {[have-feature windows]} } -} - # autosetup cc-check-function-in-library can't handle C++ libraries proc check-metakit {} { set found 0 @@ -436,7 +495,7 @@ } # Now go check everything - see autosetup/local.tcl -array set extinfo [check-extensions] +array set extinfo [check-extensions [opt-bool allextmod]] # Now special checks if {[have-feature windows]} { @@ -523,12 +582,12 @@ if {[dict exists $extdb info $mod extrasrcs]} { lappend srcs {*}[dict get $extdb info $mod extrasrcs] } - lappend lines "$mod.so: $srcs" + lappend lines "$mod.so: $srcs \$(LIBJIM)" foreach src $srcs { set obj [file rootname $src].o lappend objs $obj lappend lines "\t\$(ECHO)\t\"\tCC\t$obj\"" - lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(SHOBJ_CFLAGS) -c -o $obj $src" + lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(SHOBJ_CFLAGS) -c -o $obj \$(srcdir)/$src" } lappend lines "\t\$(ECHO)\t\"\tLDSO\t\$@\"" lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(LDFLAGS) \$(SHOBJ_LDFLAGS) -o \$@ $objs \$(SH_LIBJIM) $libs" @@ -540,7 +599,21 @@ make-config-header jimautoconf.h -auto {jim_ext_* TCL_PLATFORM_* TCL_LIBRARY USE_* JIM_* _FILE_OFFSET*} -bare {S_I*} make-template Makefile.in make-template tests/Makefile.in +make-template examples.api/Makefile.in make-template build-jim-ext.in make-template jimtcl.pc.in catch {exec chmod +x build-jim-ext} + +if {[get-define SIZEOF_TIME_T] <= 4} { + set note "" + if {[have-feature windows]} { + set note ", consider CFLAGS=-D__MINGW_USE_VC2005_COMPAT on mingw32" + } + lappend warnings "Warning: sizeof(time_t) is [get-define SIZEOF_TIME_T] -- not Y2038 compliant$note" +} + +# Output any warnings at the end to make them easier to see +foreach warning $warnings { + user-notice $warning +} diff -Nru jimtcl-0.79+dfsg0/autosetup/autosetup jimtcl-0.81+dfsg0/autosetup/autosetup --- jimtcl-0.79+dfsg0/autosetup/autosetup 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/autosetup 2021-11-27 23:06:54.000000000 +0000 @@ -6,7 +6,7 @@ dir=`dirname "$0"`; exec "`$dir/autosetup-find-tclsh`" "$0" "$@" # Note that the version has a trailing + on unreleased versions -set autosetup(version) 0.6.9 +set autosetup(version) 0.7.0+ # Can be set to 1 to debug early-init problems set autosetup(debug) [expr {"--debug" in $argv}] @@ -93,13 +93,13 @@ #"=Core Options:" options-add { - help:=local => "display help and options. Optionally specify a module name, such as --help=system" + help:=all => "display help and options. Optional: module name, such as --help=system" licence license => "display the autosetup license" - version => "display the version of autosetup" + version => "display the version of autosetup" ref:=text manual:=text reference:=text => "display the autosetup command reference. 'text', 'wiki', 'asciidoc' or 'markdown'" - debug => "display debugging output as autosetup runs" - install:=. => "install autosetup to the current or given directory" + debug => "display debugging output as autosetup runs" + install:=. => "install autosetup to the current or given directory" } if {$autosetup(installed)} { # hidden options so we can produce a nice error @@ -204,11 +204,17 @@ autosetup_add_dep $autosetup(autodef) - define CONFIGURE_OPTS "" + # Add $argv to CONFIGURE_OPTS, but ignore duplicates and quote if needed + set configure_opts {} foreach arg $autosetup(argv) { - define-append CONFIGURE_OPTS [quote-if-needed $arg] + set quoted [quote-if-needed $arg] + # O(n^2), but n will be small + if {$quoted ni $configure_opts} { + lappend configure_opts $quoted + } } - define AUTOREMAKE [file-normalize $autosetup(exe)] + define CONFIGURE_OPTS [join $configure_opts] + define AUTOREMAKE [quote-if-needed $autosetup(exe)] define-append AUTOREMAKE [get-define CONFIGURE_OPTS] @@ -216,8 +222,8 @@ configlog "Invoked as: [getenv WRAPPER $::argv0] [quote-argv $autosetup(argv)]" configlog "Tclsh: [info nameofexecutable]" - # Note that auto.def is *not* loaded in the global scope - source $autosetup(autodef) + # Load auto.def as module "auto.def" + autosetup_load_module auto.def source $autosetup(autodef) # Could warn here if options {} was not specified @@ -342,8 +348,8 @@ if {![info exists result]} { # No user-specified value. Has options-defaults been set? foreach opt $names { - if {[dict exists $::autosetup(options-defaults) $opt]} { - set result [dict get $autosetup(options-defaults) $opt] + if {[dict exists $::autosetup(optdefault) $opt]} { + set result [dict get $autosetup(optdefault) $opt] } } } @@ -375,7 +381,7 @@ # Parse the option definition in $opts and update # ::autosetup(setoptions) and ::autosetup(optionhelp) appropriately # -proc options-add {opts {header ""}} { +proc options-add {opts} { global autosetup # First weed out comment lines @@ -391,8 +397,7 @@ set opt [lindex $opts $i] if {[string match =* $opt]} { # This is a special heading - lappend autosetup(optionhelp) $opt "" - set header {} + lappend autosetup(optionhelp) [list $opt $autosetup(module)] continue } unset -nocomplain defaultvalue equal value @@ -453,8 +458,8 @@ # String option. lappend autosetup(options) $name - if {$colon eq ":"} { - # Was ":name=default" given? + if {$equal ne "="} { + # Was the option given as "name:value=default"? # If so, set $value to the display name and $defaultvalue to the default # (This is the preferred way to set a default value for a string option) if {[regexp {^([^=]+)=(.*)$} $value -> value defaultvalue]} { @@ -468,9 +473,9 @@ set defaultvalue [dict get $autosetup(options-defaults) $name] dict set autosetup(optdefault) $name $defaultvalue } elseif {![info exists defaultvalue]} { - # For backward compatibility, if ":name" was given, use name as both - # the display text and the default value, but only if the user - # specified the option without the value + # No default value was given by value=default or options-defaults + # so use the value as the default when the plain option with no + # value is given (.e.g. just --opt instead of --opt=value) set defaultvalue $value } @@ -509,13 +514,8 @@ if {[info exists defaultvalue]} { set desc [string map [list @default@ $defaultvalue] $desc] } - #string match \n* $desc - if {$header ne ""} { - lappend autosetup(optionhelp) $header "" - set header "" - } # A multi-line description - lappend autosetup(optionhelp) $opthelp $desc + lappend autosetup(optionhelp) [list $opthelp $autosetup(module) $desc] incr i 2 } } @@ -523,21 +523,9 @@ # @module-options optionlist # -# Like 'options', but used within a module. +# Deprecated. Simply use 'options' from within a module. proc module-options {opts} { - set header "" - if {$::autosetup(showhelp) > 1 && [llength $opts]} { - set header "Module Options:" - } - options-add $opts $header - - if {$::autosetup(showhelp)} { - # Ensure that the module isn't executed on --help - # We are running under eval or source, so use break - # to prevent further execution - #return -code break -level 2 - return -code break - } + options $opts } proc max {a b} { @@ -566,32 +554,49 @@ } } -proc options-show {} { +# Display options (from $autosetup(optionhelp)) for modules that match +# glob pattern $what +proc options-show {what} { + set local 0 # Determine the max option width set max 0 - foreach {opt desc} $::autosetup(optionhelp) { + foreach help $::autosetup(optionhelp) { + lassign $help opt module desc + if {![string match $what $module]} { + continue + } if {[string match =* $opt] || [string match \n* $desc]} { continue } set max [max $max [string length $opt]] } - set indent [string repeat " " [expr $max+4]] + set indent [string repeat " " [expr {$max+4}]] set cols [getenv COLUMNS 80] catch { lassign [exec stty size] rows cols } incr cols -1 # Now output - foreach {opt desc} $::autosetup(optionhelp) { + foreach help $::autosetup(optionhelp) { + lassign $help opt module desc + if {![string match $what $module]} { + continue + } + if {$local == 0 && $module eq "auto.def"} { + puts "Local Options:" + incr local + } if {[string match =* $opt]} { + # Output a special heading line" puts [string range $opt 1 end] continue } puts -nonewline " [format %-${max}s $opt]" if {[string match \n* $desc]} { + # Output a pre-formatted help description as-is puts $desc } else { - options-wrap-desc [string trim $desc] $cols " " $indent [expr $max + 2] + options-wrap-desc [string trim $desc] $cols " " $indent [expr {$max+2}] } } } @@ -610,12 +615,16 @@ # If 'name=1' is used to make the option enabled by default, the description should reflect # that with text like "Disable support for ...". # -# An argument option (one which takes a parameter) is of the form: +# An argument option (one which takes a parameter) is of one of the following forms: # -## name:[=]value => "Description of this option" +## name:value => "Description of this option" +## name:value=default => "Description of this option with a default value" +## name:=value => "Description of this option with an optional value" # # If the 'name:value' form is used, the value must be provided with the option (as '--name=myvalue'). -# If the 'name:=value' form is used, the value is optional and the given value is used as the default +# If the 'name:value=default' form is used, the option has the given default value even if not +# specified by the user. +# If the 'name:=value' form is used, the value is optional and the given value is used # if it is not provided. # # The description may contain '@default@', in which case it will be replaced with the default @@ -629,19 +638,22 @@ ## lfs=1 largefile=1 => "Disable large file support" # proc options {optlist} { - # Allow options as a list or args - options-add $optlist "Local Options:" + global autosetup - if {$::autosetup(showhelp)} { - options-show - exit 0 + options-add $optlist + + if {$autosetup(showhelp)} { + # If --help, stop now to show help + return -code break } - # Check for invalid options - if {[opt-bool option-checking]} { - foreach o [dict keys $::autosetup(getopt)] { - if {$o ni $::autosetup(options)} { - user-error "Unknown option --$o" + if {$autosetup(module) eq "auto.def"} { + # Check for invalid options + if {[opt-bool option-checking]} { + foreach o [dict keys $::autosetup(getopt)] { + if {$o ni $::autosetup(options)} { + user-error "Unknown option --$o" + } } } } @@ -1173,8 +1185,9 @@ continue } set libmodule($m) 1 + if {[info exists modsource(${m}.tcl)]} { - automf_load eval $modsource(${m}.tcl) + autosetup_load_module $m eval $modsource(${m}.tcl) } else { set locs [list ${m}.tcl ${m}/init.tcl] set found 0 @@ -1194,7 +1207,7 @@ # For the convenience of the "use" source, point to the directory # it is being loaded from set ::usedir [file dirname $source] - automf_load source $source + autosetup_load_module $m source $source autosetup_add_dep $source } else { autosetup-error "use: No such module: $m" @@ -1207,19 +1220,24 @@ global autosetup modsource # First load any embedded auto modules foreach mod [array names modsource *.auto] { - automf_load eval $modsource($mod) + autosetup_load_module $mod eval $modsource($mod) } # Now any external auto modules foreach file [glob -nocomplain $autosetup(libdir)/*.auto $autosetup(libdir)/*/*.auto] { - automf_load source $file + autosetup_load_module [file tail $file] source $file } } # Load module source in the global scope by executing the given command -proc automf_load {args} { +proc autosetup_load_module {module args} { + global autosetup + set prev $autosetup(module) + set autosetup(module) $module + if {[catch [list uplevel #0 $args] msg opts] ni {0 2 3}} { autosetup-full-error [error-dump $msg $opts $::autosetup(debug)] } + set autosetup(module) $prev } # Initial settings @@ -1231,6 +1249,7 @@ set autosetup(msg-checking) 0 set autosetup(msg-quiet) 0 set autosetup(inittypes) {} +set autosetup(module) autosetup # Embedded modules are inserted below here set autosetup(installed) 1 @@ -1434,24 +1453,24 @@ puts "Usage: [file tail $::autosetup(exe)] \[options\] \[settings\]\n" puts "This is [autosetup_version], a build environment \"autoconfigurator\"" - puts "See the documentation online at http://msteveb.github.com/autosetup/\n" + puts "See the documentation online at http://msteveb.github.io/autosetup/\n" - if {$what eq "local"} { + if {$what in {all local}} { + # Need to load auto.def now if {[file exists $::autosetup(autodef)]} { - # This relies on auto.def having a call to 'options' - # which will display options and quit - source $::autosetup(autodef) - } else { - options-show + # Load auto.def as module "auto.def" + autosetup_load_module auto.def source $::autosetup(autodef) } - } else { - incr ::autosetup(showhelp) - if {[catch {use $what}]} { - user-error "Unknown module: $what" + if {$what eq "all"} { + set what * } else { - options-show + set what auto.def } + } else { + use $what + puts "Options for module $what:" } + options-show $what exit 0 } @@ -1911,7 +1930,7 @@ *.auto files in this directory are auto-loaded. -For more information, see http://msteveb.github.com/autosetup/ +For more information, see http://msteveb.github.io/autosetup/ } dputs "install: autosetup/README.autosetup" writefile $target $readme diff -Nru jimtcl-0.79+dfsg0/autosetup/autosetup-config.guess jimtcl-0.81+dfsg0/autosetup/autosetup-config.guess --- jimtcl-0.79+dfsg0/autosetup/autosetup-config.guess 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/autosetup-config.guess 2021-11-27 23:06:54.000000000 +0000 @@ -1,8 +1,10 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright 1992-2018 Free Software Foundation, Inc. +# Copyright 1992-2021 Free Software Foundation, Inc. -timestamp='2018-03-08' +# shellcheck disable=SC2006,SC2268 # see below for rationale + +timestamp='2021-06-03' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -27,11 +29,19 @@ # Originally written by Per Bothner; maintained since 2000 by Ben Elliston. # # You can get the latest version of this script from: -# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess +# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess # # Please send patches to . +# The "shellcheck disable" line above the timestamp inhibits complaints +# about features and limitations of the classic Bourne shell that were +# superseded or lifted in POSIX. However, this script identifies a wide +# variety of pre-POSIX systems that do not have POSIX shells at all, and +# even some reasonably current systems (Solaris 10 as case-in-point) still +# have a pre-POSIX /bin/sh. + + me=`echo "$0" | sed -e 's,.*/,,'` usage="\ @@ -50,7 +60,7 @@ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2018 Free Software Foundation, Inc. +Copyright 1992-2021 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -84,7 +94,8 @@ exit 1 fi -trap 'exit 1' 1 2 15 +# Just in case it came from the environment. +GUESS= # CC_FOR_BUILD -- compiler used by this script. Note that the use of a # compiler to aid in system detection is discouraged as it requires @@ -96,73 +107,90 @@ # Portable tmp directory creation inspired by the Autoconf team. -set_cc_for_build=' -trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; -trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; -: ${TMPDIR=/tmp} ; - { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || - { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; -dummy=$tmp/dummy ; -tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; -case $CC_FOR_BUILD,$HOST_CC,$CC in - ,,) echo "int x;" > "$dummy.c" ; - for c in cc gcc c89 c99 ; do - if ($c -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then - CC_FOR_BUILD="$c"; break ; - fi ; - done ; - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found ; - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; -esac ; set_cc_for_build= ;' +tmp= +# shellcheck disable=SC2172 +trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 + +set_cc_for_build() { + # prevent multiple calls if $tmp is already set + test "$tmp" && return 0 + : "${TMPDIR=/tmp}" + # shellcheck disable=SC2039,SC3028 + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } + dummy=$tmp/dummy + case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in + ,,) echo "int x;" > "$dummy.c" + for driver in cc gcc c89 c99 ; do + if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then + CC_FOR_BUILD=$driver + break + fi + done + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; + esac +} # This is needed to find uname on a Pyramid OSx when run in the BSD universe. # (ghazi@noc.rutgers.edu 1994-08-24) -if (test -f /.attbin/uname) >/dev/null 2>&1 ; then +if test -f /.attbin/uname ; then PATH=$PATH:/.attbin ; export PATH fi UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown -case "$UNAME_SYSTEM" in +case $UNAME_SYSTEM in Linux|GNU|GNU/*) - # If the system lacks a compiler, then just pick glibc. - # We could probably try harder. - LIBC=gnu + LIBC=unknown - eval "$set_cc_for_build" + set_cc_for_build cat <<-EOF > "$dummy.c" #include #if defined(__UCLIBC__) LIBC=uclibc #elif defined(__dietlibc__) LIBC=dietlibc - #else + #elif defined(__GLIBC__) LIBC=gnu + #else + #include + /* First heuristic to detect musl libc. */ + #ifdef __DEFINED_va_list + LIBC=musl + #endif #endif EOF - eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`" + cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` + eval "$cc_set_libc" - # If ldd exists, use it to detect musl libc. - if command -v ldd >/dev/null && \ - ldd --version 2>&1 | grep -q ^musl - then - LIBC=musl + # Second heuristic to detect musl libc. + if [ "$LIBC" = unknown ] && + command -v ldd >/dev/null && + ldd --version 2>&1 | grep -q ^musl; then + LIBC=musl + fi + + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + if [ "$LIBC" = unknown ]; then + LIBC=gnu fi ;; esac # Note: order is significant - the case branches are not exclusive. -case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in +case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, @@ -174,12 +202,12 @@ # # Note: NetBSD doesn't particularly care about the vendor # portion of the name. We always set it to "unknown". - sysctl="sysctl -n hw.machine_arch" UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ - "/sbin/$sysctl" 2>/dev/null || \ - "/usr/sbin/$sysctl" 2>/dev/null || \ + /sbin/sysctl -n hw.machine_arch 2>/dev/null || \ + /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \ echo unknown)` - case "$UNAME_MACHINE_ARCH" in + case $UNAME_MACHINE_ARCH in + aarch64eb) machine=aarch64_be-unknown ;; armeb) machine=armeb-unknown ;; arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; @@ -188,18 +216,18 @@ earmv*) arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'` endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'` - machine="${arch}${endian}"-unknown + machine=${arch}${endian}-unknown ;; - *) machine="$UNAME_MACHINE_ARCH"-unknown ;; + *) machine=$UNAME_MACHINE_ARCH-unknown ;; esac # The Operating System including object format, if it has switched # to ELF recently (or will in the future) and ABI. - case "$UNAME_MACHINE_ARCH" in + case $UNAME_MACHINE_ARCH in earm*) os=netbsdelf ;; arm*|i386|m68k|ns32k|sh3*|sparc|vax) - eval "$set_cc_for_build" + set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ELF__ then @@ -215,7 +243,7 @@ ;; esac # Determine ABI tags. - case "$UNAME_MACHINE_ARCH" in + case $UNAME_MACHINE_ARCH in earm*) expr='s/^earmv[0-9]/-eabi/;s/eb$//' abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"` @@ -226,7 +254,7 @@ # thus, need a distinct triplet. However, they do not need # kernel version information, so it can be replaced with a # suitable tag, in the style of linux-gnu. - case "$UNAME_VERSION" in + case $UNAME_VERSION in Debian*) release='-gnu' ;; @@ -237,45 +265,57 @@ # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: # contains redundant information, the shorter form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "$machine-${os}${release}${abi}" - exit ;; + GUESS=$machine-${os}${release}${abi-} + ;; *:Bitrig:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE_ARCH-unknown-bitrig$UNAME_RELEASE + ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE_ARCH-unknown-openbsd$UNAME_RELEASE + ;; + *:SecBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/SecBSD.//'` + GUESS=$UNAME_MACHINE_ARCH-unknown-secbsd$UNAME_RELEASE + ;; *:LibertyBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE_ARCH-unknown-libertybsd$UNAME_RELEASE + ;; *:MidnightBSD:*:*) - echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-midnightbsd$UNAME_RELEASE + ;; *:ekkoBSD:*:*) - echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-ekkobsd$UNAME_RELEASE + ;; *:SolidBSD:*:*) - echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-solidbsd$UNAME_RELEASE + ;; + *:OS108:*:*) + GUESS=$UNAME_MACHINE-unknown-os108_$UNAME_RELEASE + ;; macppc:MirBSD:*:*) - echo powerpc-unknown-mirbsd"$UNAME_RELEASE" - exit ;; + GUESS=powerpc-unknown-mirbsd$UNAME_RELEASE + ;; *:MirBSD:*:*) - echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-mirbsd$UNAME_RELEASE + ;; *:Sortix:*:*) - echo "$UNAME_MACHINE"-unknown-sortix - exit ;; + GUESS=$UNAME_MACHINE-unknown-sortix + ;; + *:Twizzler:*:*) + GUESS=$UNAME_MACHINE-unknown-twizzler + ;; *:Redox:*:*) - echo "$UNAME_MACHINE"-unknown-redox - exit ;; + GUESS=$UNAME_MACHINE-unknown-redox + ;; mips:OSF1:*.*) - echo mips-dec-osf1 - exit ;; + GUESS=mips-dec-osf1 + ;; alpha:OSF1:*:*) + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + trap '' 0 case $UNAME_RELEASE in *4.0) UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` @@ -289,7 +329,7 @@ # covers most systems running today. This code pipes the CPU # types through head -n 1, so we only detect the type of CPU 0. ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case "$ALPHA_CPU_TYPE" in + case $ALPHA_CPU_TYPE in "EV4 (21064)") UNAME_MACHINE=alpha ;; "EV4.5 (21064)") @@ -326,75 +366,76 @@ # A Tn.n version is a released field test version. # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. - echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`" - # Reset EXIT trap before exiting to avoid spurious non-zero exit code. - exitcode=$? - trap '' 0 - exit $exitcode ;; + OSF_REL=`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` + GUESS=$UNAME_MACHINE-dec-osf$OSF_REL + ;; Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit ;; + GUESS=m68k-unknown-sysv4 + ;; *:[Aa]miga[Oo][Ss]:*:*) - echo "$UNAME_MACHINE"-unknown-amigaos - exit ;; + GUESS=$UNAME_MACHINE-unknown-amigaos + ;; *:[Mm]orph[Oo][Ss]:*:*) - echo "$UNAME_MACHINE"-unknown-morphos - exit ;; + GUESS=$UNAME_MACHINE-unknown-morphos + ;; *:OS/390:*:*) - echo i370-ibm-openedition - exit ;; + GUESS=i370-ibm-openedition + ;; *:z/VM:*:*) - echo s390-ibm-zvmoe - exit ;; + GUESS=s390-ibm-zvmoe + ;; *:OS400:*:*) - echo powerpc-ibm-os400 - exit ;; + GUESS=powerpc-ibm-os400 + ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix"$UNAME_RELEASE" - exit ;; + GUESS=arm-acorn-riscix$UNAME_RELEASE + ;; arm*:riscos:*:*|arm*:RISCOS:*:*) - echo arm-unknown-riscos - exit ;; + GUESS=arm-unknown-riscos + ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit ;; + GUESS=hppa1.1-hitachi-hiuxmpp + ;; Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit ;; + case `(/bin/universe) 2>/dev/null` in + att) GUESS=pyramid-pyramid-sysv3 ;; + *) GUESS=pyramid-pyramid-bsd ;; + esac + ;; NILE*:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit ;; + GUESS=pyramid-pyramid-svr4 + ;; DRS?6000:unix:4.0:6*) - echo sparc-icl-nx6 - exit ;; + GUESS=sparc-icl-nx6 + ;; DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) case `/usr/bin/uname -p` in - sparc) echo sparc-icl-nx7; exit ;; - esac ;; + sparc) GUESS=sparc-icl-nx7 ;; + esac + ;; s390x:SunOS:*:*) - echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=$UNAME_MACHINE-ibm-solaris2$SUN_REL + ;; sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-hal-solaris2$SUN_REL + ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-sun-solaris2$SUN_REL + ;; i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) - echo i386-pc-auroraux"$UNAME_RELEASE" - exit ;; + GUESS=i386-pc-auroraux$UNAME_RELEASE + ;; i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - eval "$set_cc_for_build" + set_cc_for_build SUN_ARCH=i386 # If there is a compiler, see if it is configured for 64-bit objects. # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. # This test works for both compilers. - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then + if test "$CC_FOR_BUILD" != no_compiler_found; then if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null @@ -402,41 +443,44 @@ SUN_ARCH=x86_64 fi fi - echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=$SUN_ARCH-pc-solaris2$SUN_REL + ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize # SunOS6. Hard to guess exactly what SunOS6 will be like, but # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=sparc-sun-solaris3$SUN_REL + ;; sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in + case `/usr/bin/arch -k` in Series*|S4*) UNAME_RELEASE=`uname -v` ;; esac # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos"`echo "$UNAME_RELEASE"|sed -e 's/-/_/'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'` + GUESS=sparc-sun-sunos$SUN_REL + ;; sun3*:SunOS:*:*) - echo m68k-sun-sunos"$UNAME_RELEASE" - exit ;; + GUESS=m68k-sun-sunos$UNAME_RELEASE + ;; sun*:*:4.2BSD:*) UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 - case "`/bin/arch`" in + case `/bin/arch` in sun3) - echo m68k-sun-sunos"$UNAME_RELEASE" + GUESS=m68k-sun-sunos$UNAME_RELEASE ;; sun4) - echo sparc-sun-sunos"$UNAME_RELEASE" + GUESS=sparc-sun-sunos$UNAME_RELEASE ;; esac - exit ;; + ;; aushp:SunOS:*:*) - echo sparc-auspex-sunos"$UNAME_RELEASE" - exit ;; + GUESS=sparc-auspex-sunos$UNAME_RELEASE + ;; # The situation for MiNT is a little confusing. The machine name # can be virtually everything (everything which is not # "atarist" or "atariste" at least should have a processor @@ -446,43 +490,43 @@ # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-atari-mint$UNAME_RELEASE + ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-milan-mint$UNAME_RELEASE + ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-hades-mint$UNAME_RELEASE + ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint"$UNAME_RELEASE" - exit ;; + GUESS=m68k-unknown-mint$UNAME_RELEASE + ;; m68k:machten:*:*) - echo m68k-apple-machten"$UNAME_RELEASE" - exit ;; + GUESS=m68k-apple-machten$UNAME_RELEASE + ;; powerpc:machten:*:*) - echo powerpc-apple-machten"$UNAME_RELEASE" - exit ;; + GUESS=powerpc-apple-machten$UNAME_RELEASE + ;; RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit ;; + GUESS=mips-dec-mach_bsd4.3 + ;; RISC*:ULTRIX:*:*) - echo mips-dec-ultrix"$UNAME_RELEASE" - exit ;; + GUESS=mips-dec-ultrix$UNAME_RELEASE + ;; VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix"$UNAME_RELEASE" - exit ;; + GUESS=vax-dec-ultrix$UNAME_RELEASE + ;; 2020:CLIX:*:* | 2430:CLIX:*:*) - echo clipper-intergraph-clix"$UNAME_RELEASE" - exit ;; + GUESS=clipper-intergraph-clix$UNAME_RELEASE + ;; mips:*:*:UMIPS | mips:*:*:RISCos) - eval "$set_cc_for_build" + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #ifdef __cplusplus #include /* for printf() prototype */ @@ -508,78 +552,79 @@ dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` && SYSTEM_NAME=`"$dummy" "$dummyarg"` && { echo "$SYSTEM_NAME"; exit; } - echo mips-mips-riscos"$UNAME_RELEASE" - exit ;; + GUESS=mips-mips-riscos$UNAME_RELEASE + ;; Motorola:PowerMAX_OS:*:*) - echo powerpc-motorola-powermax - exit ;; + GUESS=powerpc-motorola-powermax + ;; Motorola:*:4.3:PL8-*) - echo powerpc-harris-powermax - exit ;; + GUESS=powerpc-harris-powermax + ;; Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) - echo powerpc-harris-powermax - exit ;; + GUESS=powerpc-harris-powermax + ;; Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit ;; + GUESS=powerpc-harris-powerunix + ;; m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit ;; + GUESS=m88k-harris-cxux7 + ;; m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit ;; + GUESS=m88k-motorola-sysv4 + ;; m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit ;; + GUESS=m88k-motorola-sysv3 + ;; AViiON:dgux:*:*) # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ] + if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110 then - if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \ - [ "$TARGET_BINARY_INTERFACE"x = x ] + if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \ + test "$TARGET_BINARY_INTERFACE"x = x then - echo m88k-dg-dgux"$UNAME_RELEASE" + GUESS=m88k-dg-dgux$UNAME_RELEASE else - echo m88k-dg-dguxbcs"$UNAME_RELEASE" + GUESS=m88k-dg-dguxbcs$UNAME_RELEASE fi else - echo i586-dg-dgux"$UNAME_RELEASE" + GUESS=i586-dg-dgux$UNAME_RELEASE fi - exit ;; + ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit ;; + GUESS=m88k-dolphin-sysv3 + ;; M88*:*:R3*:*) # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit ;; + GUESS=m88k-motorola-sysv3 + ;; XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit ;; + GUESS=m88k-tektronix-sysv3 + ;; Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit ;; + GUESS=m68k-tektronix-bsd + ;; *:IRIX*:*:*) - echo mips-sgi-irix"`echo "$UNAME_RELEASE"|sed -e 's/-/_/g'`" - exit ;; + IRIX_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/g'` + GUESS=mips-sgi-irix$IRIX_REL + ;; ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + GUESS=romp-ibm-aix # uname -m gives an 8 hex-code CPU id + ;; # Note that: echo "'`uname -s`'" gives 'AIX ' i*86:AIX:*:*) - echo i386-ibm-aix - exit ;; + GUESS=i386-ibm-aix + ;; ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then + if test -x /usr/bin/oslevel ; then IBM_REV=`/usr/bin/oslevel` else - IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + IBM_REV=$UNAME_VERSION.$UNAME_RELEASE fi - echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV" - exit ;; + GUESS=$UNAME_MACHINE-ibm-aix$IBM_REV + ;; *:AIX:2:3) if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - eval "$set_cc_for_build" + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #include @@ -593,16 +638,16 @@ EOF if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` then - echo "$SYSTEM_NAME" + GUESS=$SYSTEM_NAME else - echo rs6000-ibm-aix3.2.5 + GUESS=rs6000-ibm-aix3.2.5 fi elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 + GUESS=rs6000-ibm-aix3.2.4 else - echo rs6000-ibm-aix3.2 + GUESS=rs6000-ibm-aix3.2 fi - exit ;; + ;; *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then @@ -610,57 +655,57 @@ else IBM_ARCH=powerpc fi - if [ -x /usr/bin/lslpp ] ; then - IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | + if test -x /usr/bin/lslpp ; then + IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | \ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` else - IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + IBM_REV=$UNAME_VERSION.$UNAME_RELEASE fi - echo "$IBM_ARCH"-ibm-aix"$IBM_REV" - exit ;; + GUESS=$IBM_ARCH-ibm-aix$IBM_REV + ;; *:AIX:*:*) - echo rs6000-ibm-aix - exit ;; + GUESS=rs6000-ibm-aix + ;; ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) - echo romp-ibm-bsd4.4 - exit ;; + GUESS=romp-ibm-bsd4.4 + ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - echo romp-ibm-bsd"$UNAME_RELEASE" # 4.3 with uname added to - exit ;; # report: romp-ibm BSD 4.3 + GUESS=romp-ibm-bsd$UNAME_RELEASE # 4.3 with uname added to + ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) - echo rs6000-bull-bosx - exit ;; + GUESS=rs6000-bull-bosx + ;; DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit ;; + GUESS=m68k-bull-sysv3 + ;; 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit ;; + GUESS=m68k-hp-bsd + ;; hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit ;; + GUESS=m68k-hp-bsd4.4 + ;; 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` - case "$UNAME_MACHINE" in + HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'` + case $UNAME_MACHINE in 9000/31?) HP_ARCH=m68000 ;; 9000/[34]??) HP_ARCH=m68k ;; 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then + if test -x /usr/bin/getconf; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "$sc_cpu_version" in + case $sc_cpu_version in 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 532) # CPU_PA_RISC2_0 - case "$sc_kernel_bits" in + case $sc_kernel_bits in 32) HP_ARCH=hppa2.0n ;; 64) HP_ARCH=hppa2.0w ;; '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 esac ;; esac fi - if [ "$HP_ARCH" = "" ]; then - eval "$set_cc_for_build" + if test "$HP_ARCH" = ""; then + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #define _HPUX_SOURCE @@ -698,9 +743,9 @@ test -z "$HP_ARCH" && HP_ARCH=hppa fi ;; esac - if [ "$HP_ARCH" = hppa2.0w ] + if test "$HP_ARCH" = hppa2.0w then - eval "$set_cc_for_build" + set_cc_for_build # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler @@ -719,14 +764,14 @@ HP_ARCH=hppa64 fi fi - echo "$HP_ARCH"-hp-hpux"$HPUX_REV" - exit ;; + GUESS=$HP_ARCH-hp-hpux$HPUX_REV + ;; ia64:HP-UX:*:*) - HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` - echo ia64-hp-hpux"$HPUX_REV" - exit ;; + HPUX_REV=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*.[0B]*//'` + GUESS=ia64-hp-hpux$HPUX_REV + ;; 3050*:HI-UX:*:*) - eval "$set_cc_for_build" + set_cc_for_build sed 's/^ //' << EOF > "$dummy.c" #include int @@ -754,36 +799,36 @@ EOF $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` && { echo "$SYSTEM_NAME"; exit; } - echo unknown-hitachi-hiuxwe2 - exit ;; + GUESS=unknown-hitachi-hiuxwe2 + ;; 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) - echo hppa1.1-hp-bsd - exit ;; + GUESS=hppa1.1-hp-bsd + ;; 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit ;; + GUESS=hppa1.0-hp-bsd + ;; *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit ;; + GUESS=hppa1.0-hp-mpeix + ;; hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) - echo hppa1.1-hp-osf - exit ;; + GUESS=hppa1.1-hp-osf + ;; hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit ;; + GUESS=hppa1.0-hp-osf + ;; i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo "$UNAME_MACHINE"-unknown-osf1mk + if test -x /usr/sbin/sysversion ; then + GUESS=$UNAME_MACHINE-unknown-osf1mk else - echo "$UNAME_MACHINE"-unknown-osf1 + GUESS=$UNAME_MACHINE-unknown-osf1 fi - exit ;; + ;; parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit ;; + GUESS=hppa1.1-hp-lites + ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit ;; + GUESS=c1-convex-bsd + ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd @@ -791,17 +836,18 @@ fi exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit ;; + GUESS=c34-convex-bsd + ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit ;; + GUESS=c38-convex-bsd + ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit ;; + GUESS=c4-convex-bsd + ;; CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=ymp-cray-unicos$CRAY_REL + ;; CRAY*[A-Z]90:*:*:*) echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ @@ -809,103 +855,126 @@ -e 's/\.[^.]*$/.X/' exit ;; CRAY*TS:*:*:*) - echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=t90-cray-unicos$CRAY_REL + ;; CRAY*T3E:*:*:*) - echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=alphaev5-cray-unicosmk$CRAY_REL + ;; CRAY*SV1:*:*:*) - echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=sv1-cray-unicos$CRAY_REL + ;; *:UNICOS/mp:*:*) - echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; + CRAY_REL=`echo "$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/'` + GUESS=craynv-cray-unicosmp$CRAY_REL + ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + GUESS=${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL} + ;; 5000:UNIX_System_V:4.*:*) FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + GUESS=sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL} + ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-pc-bsdi$UNAME_RELEASE + ;; sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi"$UNAME_RELEASE" - exit ;; + GUESS=sparc-unknown-bsdi$UNAME_RELEASE + ;; *:BSD/OS:*:*) - echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-unknown-bsdi$UNAME_RELEASE + ;; + arm:FreeBSD:*:*) + UNAME_PROCESSOR=`uname -p` + set_cc_for_build + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabi + else + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabihf + fi + ;; *:FreeBSD:*:*) UNAME_PROCESSOR=`/usr/bin/uname -p` - case "$UNAME_PROCESSOR" in + case $UNAME_PROCESSOR in amd64) UNAME_PROCESSOR=x86_64 ;; i386) UNAME_PROCESSOR=i586 ;; esac - echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" - exit ;; + FREEBSD_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL + ;; i*:CYGWIN*:*) - echo "$UNAME_MACHINE"-pc-cygwin - exit ;; + GUESS=$UNAME_MACHINE-pc-cygwin + ;; *:MINGW64*:*) - echo "$UNAME_MACHINE"-pc-mingw64 - exit ;; + GUESS=$UNAME_MACHINE-pc-mingw64 + ;; *:MINGW*:*) - echo "$UNAME_MACHINE"-pc-mingw32 - exit ;; + GUESS=$UNAME_MACHINE-pc-mingw32 + ;; *:MSYS*:*) - echo "$UNAME_MACHINE"-pc-msys - exit ;; + GUESS=$UNAME_MACHINE-pc-msys + ;; i*:PW*:*) - echo "$UNAME_MACHINE"-pc-pw32 - exit ;; + GUESS=$UNAME_MACHINE-pc-pw32 + ;; *:Interix*:*) - case "$UNAME_MACHINE" in + case $UNAME_MACHINE in x86) - echo i586-pc-interix"$UNAME_RELEASE" - exit ;; + GUESS=i586-pc-interix$UNAME_RELEASE + ;; authenticamd | genuineintel | EM64T) - echo x86_64-unknown-interix"$UNAME_RELEASE" - exit ;; + GUESS=x86_64-unknown-interix$UNAME_RELEASE + ;; IA64) - echo ia64-unknown-interix"$UNAME_RELEASE" - exit ;; + GUESS=ia64-unknown-interix$UNAME_RELEASE + ;; esac ;; i*:UWIN*:*) - echo "$UNAME_MACHINE"-pc-uwin - exit ;; + GUESS=$UNAME_MACHINE-pc-uwin + ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - echo x86_64-unknown-cygwin - exit ;; + GUESS=x86_64-pc-cygwin + ;; prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; + SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'` + GUESS=powerpcle-unknown-solaris2$SUN_REL + ;; *:GNU:*:*) # the GNU system - echo "`echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"|sed -e 's,/.*$,,'`" - exit ;; + GNU_ARCH=`echo "$UNAME_MACHINE" | sed -e 's,[-/].*$,,'` + GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's,/.*$,,'` + GUESS=$GNU_ARCH-unknown-$LIBC$GNU_REL + ;; *:GNU/*:*:*) # other systems with GNU libc and userland - echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC" - exit ;; - i*86:Minix:*:*) - echo "$UNAME_MACHINE"-pc-minix - exit ;; + GNU_SYS=`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"` + GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC + ;; + *:Minix:*:*) + GUESS=$UNAME_MACHINE-unknown-minix + ;; aarch64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; aarch64_be:Linux:*:*) UNAME_MACHINE=aarch64_be - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in EV5) UNAME_MACHINE=alphaev5 ;; EV56) UNAME_MACHINE=alphaev56 ;; PCA56) UNAME_MACHINE=alphapca56 ;; @@ -916,183 +985,225 @@ esac objdump --private-headers /bin/sh | grep -q ld.so.1 if test "$?" = 0 ; then LIBC=gnulibc1 ; fi - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - arc:Linux:*:* | arceb:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + arc:Linux:*:* | arceb:Linux:*:* | arc32:Linux:*:* | arc64:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; arm*:Linux:*:*) - eval "$set_cc_for_build" + set_cc_for_build if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_EABI__ then - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC else if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ | grep -q __ARM_PCS_VFP then - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi + GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabi else - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf + GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabihf fi fi - exit ;; + ;; avr32*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; cris:Linux:*:*) - echo "$UNAME_MACHINE"-axis-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-axis-linux-$LIBC + ;; crisv32:Linux:*:*) - echo "$UNAME_MACHINE"-axis-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-axis-linux-$LIBC + ;; e2k:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; frv:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; hexagon:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; i*86:Linux:*:*) - echo "$UNAME_MACHINE"-pc-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-pc-linux-$LIBC + ;; ia64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; k1om:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; m32r*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; m68*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; mips:Linux:*:* | mips64:Linux:*:*) - eval "$set_cc_for_build" + set_cc_for_build + IS_GLIBC=0 + test x"${LIBC}" = xgnu && IS_GLIBC=1 sed 's/^ //' << EOF > "$dummy.c" #undef CPU - #undef ${UNAME_MACHINE} - #undef ${UNAME_MACHINE}el + #undef mips + #undef mipsel + #undef mips64 + #undef mips64el + #if ${IS_GLIBC} && defined(_ABI64) + LIBCABI=gnuabi64 + #else + #if ${IS_GLIBC} && defined(_ABIN32) + LIBCABI=gnuabin32 + #else + LIBCABI=${LIBC} + #endif + #endif + + #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa64r6 + #else + #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa32r6 + #else + #if defined(__mips64) + CPU=mips64 + #else + CPU=mips + #endif + #endif + #endif + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=${UNAME_MACHINE}el + MIPS_ENDIAN=el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=${UNAME_MACHINE} + MIPS_ENDIAN= #else - CPU= + MIPS_ENDIAN= #endif #endif EOF - eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU'`" - test "x$CPU" != x && { echo "$CPU-unknown-linux-$LIBC"; exit; } + cc_set_vars=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'` + eval "$cc_set_vars" + test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; } ;; mips64el:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; openrisc*:Linux:*:*) - echo or1k-unknown-linux-"$LIBC" - exit ;; + GUESS=or1k-unknown-linux-$LIBC + ;; or32:Linux:*:* | or1k*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; padre:Linux:*:*) - echo sparc-unknown-linux-"$LIBC" - exit ;; + GUESS=sparc-unknown-linux-$LIBC + ;; parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-"$LIBC" - exit ;; + GUESS=hppa64-unknown-linux-$LIBC + ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;; - PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;; - *) echo hppa-unknown-linux-"$LIBC" ;; + PA7*) GUESS=hppa1.1-unknown-linux-$LIBC ;; + PA8*) GUESS=hppa2.0-unknown-linux-$LIBC ;; + *) GUESS=hppa-unknown-linux-$LIBC ;; esac - exit ;; + ;; ppc64:Linux:*:*) - echo powerpc64-unknown-linux-"$LIBC" - exit ;; + GUESS=powerpc64-unknown-linux-$LIBC + ;; ppc:Linux:*:*) - echo powerpc-unknown-linux-"$LIBC" - exit ;; + GUESS=powerpc-unknown-linux-$LIBC + ;; ppc64le:Linux:*:*) - echo powerpc64le-unknown-linux-"$LIBC" - exit ;; + GUESS=powerpc64le-unknown-linux-$LIBC + ;; ppcle:Linux:*:*) - echo powerpcle-unknown-linux-"$LIBC" - exit ;; - riscv32:Linux:*:* | riscv64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=powerpcle-unknown-linux-$LIBC + ;; + riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; s390:Linux:*:* | s390x:Linux:*:*) - echo "$UNAME_MACHINE"-ibm-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-ibm-linux-$LIBC + ;; sh64*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; sh*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; sparc:Linux:*:* | sparc64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; tile*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; vax:Linux:*:*) - echo "$UNAME_MACHINE"-dec-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-dec-linux-$LIBC + ;; x86_64:Linux:*:*) - echo "$UNAME_MACHINE"-pc-linux-"$LIBC" - exit ;; + set_cc_for_build + LIBCABI=$LIBC + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_X32 >/dev/null + then + LIBCABI=${LIBC}x32 + fi + fi + GUESS=$UNAME_MACHINE-pc-linux-$LIBCABI + ;; xtensa*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both # sysname and nodename. - echo i386-sequent-sysv4 - exit ;; + GUESS=i386-sequent-sysv4 + ;; i*86:UNIX_SV:4.2MP:2.*) # Unixware is an offshoot of SVR4, but it has its own version # number series starting with 2... # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. # Use sysv4.2uw... so that sysv4* matches it. - echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION" - exit ;; + GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION + ;; i*86:OS/2:*:*) # If we were able to find `uname', then EMX Unix compatibility # is probably installed. - echo "$UNAME_MACHINE"-pc-os2-emx - exit ;; + GUESS=$UNAME_MACHINE-pc-os2-emx + ;; i*86:XTS-300:*:STOP) - echo "$UNAME_MACHINE"-unknown-stop - exit ;; + GUESS=$UNAME_MACHINE-unknown-stop + ;; i*86:atheos:*:*) - echo "$UNAME_MACHINE"-unknown-atheos - exit ;; + GUESS=$UNAME_MACHINE-unknown-atheos + ;; i*86:syllable:*:*) - echo "$UNAME_MACHINE"-pc-syllable - exit ;; + GUESS=$UNAME_MACHINE-pc-syllable + ;; i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) - echo i386-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=i386-unknown-lynxos$UNAME_RELEASE + ;; i*86:*DOS:*:*) - echo "$UNAME_MACHINE"-pc-msdosdjgpp - exit ;; + GUESS=$UNAME_MACHINE-pc-msdosdjgpp + ;; i*86:*:4.*:*) UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'` if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL" + GUESS=$UNAME_MACHINE-univel-sysv$UNAME_REL else - echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL" + GUESS=$UNAME_MACHINE-pc-sysv$UNAME_REL fi - exit ;; + ;; i*86:*:5:[678]*) # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in @@ -1100,12 +1211,12 @@ *Pentium) UNAME_MACHINE=i586 ;; *Pent*|*Celeron) UNAME_MACHINE=i686 ;; esac - echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}{$UNAME_VERSION}" - exit ;; + GUESS=$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + ;; i*86:*:3.2:*) if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 @@ -1115,11 +1226,11 @@ && UNAME_MACHINE=i686 (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ && UNAME_MACHINE=i686 - echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL" + GUESS=$UNAME_MACHINE-pc-sco$UNAME_REL else - echo "$UNAME_MACHINE"-pc-sysv32 + GUESS=$UNAME_MACHINE-pc-sysv32 fi - exit ;; + ;; pc:*:*:*) # Left here for compatibility: # uname -m prints for DJGPP always 'pc', but it prints nothing about @@ -1127,31 +1238,31 @@ # Note: whatever this is, it MUST be the same as what config.sub # prints for the "djgpp" host, or else GDB configure will decide that # this is a cross-build. - echo i586-pc-msdosdjgpp - exit ;; + GUESS=i586-pc-msdosdjgpp + ;; Intel:Mach:3*:*) - echo i386-pc-mach3 - exit ;; + GUESS=i386-pc-mach3 + ;; paragon:*:*:*) - echo i860-intel-osf1 - exit ;; + GUESS=i860-intel-osf1 + ;; i860:*:4.*:*) # i860-SVR4 if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4 + GUESS=i860-stardent-sysv$UNAME_RELEASE # Stardent Vistra i860-SVR4 else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv"$UNAME_RELEASE" # Unknown i860-SVR4 + GUESS=i860-unknown-sysv$UNAME_RELEASE # Unknown i860-SVR4 fi - exit ;; + ;; mini*:CTIX:SYS*5:*) # "miniframe" - echo m68010-convergent-sysv - exit ;; + GUESS=m68010-convergent-sysv + ;; mc68k:UNIX:SYSTEM5:3.51m) - echo m68k-convergent-sysv - exit ;; + GUESS=m68k-convergent-sysv + ;; M680?0:D-NIX:5.3:*) - echo m68k-diab-dnix - exit ;; + GUESS=m68k-diab-dnix + ;; M68*:*:R3V[5678]*:*) test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) @@ -1176,249 +1287,401 @@ /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) - echo m68k-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=m68k-unknown-lynxos$UNAME_RELEASE + ;; mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit ;; + GUESS=m68k-atari-sysv4 + ;; TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=sparc-unknown-lynxos$UNAME_RELEASE + ;; rs6000:LynxOS:2.*:*) - echo rs6000-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=rs6000-unknown-lynxos$UNAME_RELEASE + ;; PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) - echo powerpc-unknown-lynxos"$UNAME_RELEASE" - exit ;; + GUESS=powerpc-unknown-lynxos$UNAME_RELEASE + ;; SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv"$UNAME_RELEASE" - exit ;; + GUESS=mips-dde-sysv$UNAME_RELEASE + ;; RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 - exit ;; + GUESS=mips-sni-sysv4 + ;; RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit ;; + GUESS=mips-sni-sysv4 + ;; *:SINIX-*:*:*) if uname -p 2>/dev/null >/dev/null ; then UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo "$UNAME_MACHINE"-sni-sysv4 + GUESS=$UNAME_MACHINE-sni-sysv4 else - echo ns32k-sni-sysv + GUESS=ns32k-sni-sysv fi - exit ;; + ;; PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort # says - echo i586-unisys-sysv4 - exit ;; + GUESS=i586-unisys-sysv4 + ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes . # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit ;; + GUESS=hppa1.1-stratus-sysv4 + ;; *:*:*:FTX*) # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit ;; + GUESS=i860-stratus-sysv4 + ;; i*86:VOS:*:*) # From Paul.Green@stratus.com. - echo "$UNAME_MACHINE"-stratus-vos - exit ;; + GUESS=$UNAME_MACHINE-stratus-vos + ;; *:VOS:*:*) # From Paul.Green@stratus.com. - echo hppa1.1-stratus-vos - exit ;; + GUESS=hppa1.1-stratus-vos + ;; mc68*:A/UX:*:*) - echo m68k-apple-aux"$UNAME_RELEASE" - exit ;; + GUESS=m68k-apple-aux$UNAME_RELEASE + ;; news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit ;; + GUESS=mips-sony-newsos6 + ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv"$UNAME_RELEASE" + if test -d /usr/nec; then + GUESS=mips-nec-sysv$UNAME_RELEASE else - echo mips-unknown-sysv"$UNAME_RELEASE" + GUESS=mips-unknown-sysv$UNAME_RELEASE fi - exit ;; + ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit ;; + GUESS=powerpc-be-beos + ;; BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit ;; + GUESS=powerpc-apple-beos + ;; BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit ;; + GUESS=i586-pc-beos + ;; BePC:Haiku:*:*) # Haiku running on Intel PC compatible. - echo i586-pc-haiku - exit ;; + GUESS=i586-pc-haiku + ;; x86_64:Haiku:*:*) - echo x86_64-unknown-haiku - exit ;; + GUESS=x86_64-unknown-haiku + ;; SX-4:SUPER-UX:*:*) - echo sx4-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx4-nec-superux$UNAME_RELEASE + ;; SX-5:SUPER-UX:*:*) - echo sx5-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx5-nec-superux$UNAME_RELEASE + ;; SX-6:SUPER-UX:*:*) - echo sx6-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx6-nec-superux$UNAME_RELEASE + ;; SX-7:SUPER-UX:*:*) - echo sx7-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx7-nec-superux$UNAME_RELEASE + ;; SX-8:SUPER-UX:*:*) - echo sx8-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx8-nec-superux$UNAME_RELEASE + ;; SX-8R:SUPER-UX:*:*) - echo sx8r-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sx8r-nec-superux$UNAME_RELEASE + ;; SX-ACE:SUPER-UX:*:*) - echo sxace-nec-superux"$UNAME_RELEASE" - exit ;; + GUESS=sxace-nec-superux$UNAME_RELEASE + ;; Power*:Rhapsody:*:*) - echo powerpc-apple-rhapsody"$UNAME_RELEASE" - exit ;; + GUESS=powerpc-apple-rhapsody$UNAME_RELEASE + ;; *:Rhapsody:*:*) - echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-apple-rhapsody$UNAME_RELEASE + ;; + arm64:Darwin:*:*) + GUESS=aarch64-apple-darwin$UNAME_RELEASE + ;; *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - eval "$set_cc_for_build" - if test "$UNAME_PROCESSOR" = unknown ; then - UNAME_PROCESSOR=powerpc - fi - if test "`echo "$UNAME_RELEASE" | sed -e 's/\..*//'`" -le 10 ; then - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then - if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - case $UNAME_PROCESSOR in - i386) UNAME_PROCESSOR=x86_64 ;; - powerpc) UNAME_PROCESSOR=powerpc64 ;; - esac - fi - # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc - if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_PPC >/dev/null - then - UNAME_PROCESSOR=powerpc - fi + UNAME_PROCESSOR=`uname -p` + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + if command -v xcode-select > /dev/null 2> /dev/null && \ + ! xcode-select --print-path > /dev/null 2> /dev/null ; then + # Avoid executing cc if there is no toolchain installed as + # cc will be a stub that puts up a graphical alert + # prompting the user to install developer tools. + CC_FOR_BUILD=no_compiler_found + else + set_cc_for_build + fi + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc + if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_PPC >/dev/null + then + UNAME_PROCESSOR=powerpc fi elif test "$UNAME_PROCESSOR" = i386 ; then - # Avoid executing cc on OS X 10.9, as it ships with a stub - # that puts up a graphical alert prompting to install - # developer tools. Any system running Mac OS X 10.7 or - # later (Darwin 11 and later) is required to have a 64-bit - # processor. This is not true of the ARM version of Darwin - # that Apple uses in portable devices. - UNAME_PROCESSOR=x86_64 + # uname -m returns i386 or x86_64 + UNAME_PROCESSOR=$UNAME_MACHINE fi - echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_PROCESSOR-apple-darwin$UNAME_RELEASE + ;; *:procnto*:*:* | *:QNX:[0123456789]*:*) UNAME_PROCESSOR=`uname -p` if test "$UNAME_PROCESSOR" = x86; then UNAME_PROCESSOR=i386 UNAME_MACHINE=pc fi - echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_PROCESSOR-$UNAME_MACHINE-nto-qnx$UNAME_RELEASE + ;; *:QNX:*:4*) - echo i386-pc-qnx - exit ;; + GUESS=i386-pc-qnx + ;; NEO-*:NONSTOP_KERNEL:*:*) - echo neo-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=neo-tandem-nsk$UNAME_RELEASE + ;; NSE-*:NONSTOP_KERNEL:*:*) - echo nse-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=nse-tandem-nsk$UNAME_RELEASE + ;; NSR-*:NONSTOP_KERNEL:*:*) - echo nsr-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=nsr-tandem-nsk$UNAME_RELEASE + ;; NSV-*:NONSTOP_KERNEL:*:*) - echo nsv-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=nsv-tandem-nsk$UNAME_RELEASE + ;; NSX-*:NONSTOP_KERNEL:*:*) - echo nsx-tandem-nsk"$UNAME_RELEASE" - exit ;; + GUESS=nsx-tandem-nsk$UNAME_RELEASE + ;; *:NonStop-UX:*:*) - echo mips-compaq-nonstopux - exit ;; + GUESS=mips-compaq-nonstopux + ;; BS2000:POSIX*:*:*) - echo bs2000-siemens-sysv - exit ;; + GUESS=bs2000-siemens-sysv + ;; DS/*:UNIX_System_V:*:*) - echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE" - exit ;; + GUESS=$UNAME_MACHINE-$UNAME_SYSTEM-$UNAME_RELEASE + ;; *:Plan9:*:*) # "uname -m" is not consistent, so use $cputype instead. 386 # is converted to i386 for consistency with other x86 # operating systems. - if test "$cputype" = 386; then + if test "${cputype-}" = 386; then UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" + elif test "x${cputype-}" != x; then + UNAME_MACHINE=$cputype fi - echo "$UNAME_MACHINE"-unknown-plan9 - exit ;; + GUESS=$UNAME_MACHINE-unknown-plan9 + ;; *:TOPS-10:*:*) - echo pdp10-unknown-tops10 - exit ;; + GUESS=pdp10-unknown-tops10 + ;; *:TENEX:*:*) - echo pdp10-unknown-tenex - exit ;; + GUESS=pdp10-unknown-tenex + ;; KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - echo pdp10-dec-tops20 - exit ;; + GUESS=pdp10-dec-tops20 + ;; XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - echo pdp10-xkl-tops20 - exit ;; + GUESS=pdp10-xkl-tops20 + ;; *:TOPS-20:*:*) - echo pdp10-unknown-tops20 - exit ;; + GUESS=pdp10-unknown-tops20 + ;; *:ITS:*:*) - echo pdp10-unknown-its - exit ;; + GUESS=pdp10-unknown-its + ;; SEI:*:*:SEIUX) - echo mips-sei-seiux"$UNAME_RELEASE" - exit ;; + GUESS=mips-sei-seiux$UNAME_RELEASE + ;; *:DragonFly:*:*) - echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" - exit ;; + DRAGONFLY_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` + GUESS=$UNAME_MACHINE-unknown-dragonfly$DRAGONFLY_REL + ;; *:*VMS:*:*) UNAME_MACHINE=`(uname -p) 2>/dev/null` - case "$UNAME_MACHINE" in - A*) echo alpha-dec-vms ; exit ;; - I*) echo ia64-dec-vms ; exit ;; - V*) echo vax-dec-vms ; exit ;; + case $UNAME_MACHINE in + A*) GUESS=alpha-dec-vms ;; + I*) GUESS=ia64-dec-vms ;; + V*) GUESS=vax-dec-vms ;; esac ;; *:XENIX:*:SysV) - echo i386-pc-xenix - exit ;; + GUESS=i386-pc-xenix + ;; i*86:skyos:*:*) - echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`" - exit ;; + SKYOS_REL=`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'` + GUESS=$UNAME_MACHINE-pc-skyos$SKYOS_REL + ;; i*86:rdos:*:*) - echo "$UNAME_MACHINE"-pc-rdos - exit ;; - i*86:AROS:*:*) - echo "$UNAME_MACHINE"-pc-aros - exit ;; + GUESS=$UNAME_MACHINE-pc-rdos + ;; + *:AROS:*:*) + GUESS=$UNAME_MACHINE-unknown-aros + ;; x86_64:VMkernel:*:*) - echo "$UNAME_MACHINE"-unknown-esx - exit ;; + GUESS=$UNAME_MACHINE-unknown-esx + ;; amd64:Isilon\ OneFS:*:*) - echo x86_64-unknown-onefs - exit ;; + GUESS=x86_64-unknown-onefs + ;; + *:Unleashed:*:*) + GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE + ;; esac +# Do we have a guess based on uname results? +if test "x$GUESS" != x; then + echo "$GUESS" + exit +fi + +# No uname command or uname output not recognized. +set_cc_for_build +cat > "$dummy.c" < +#include +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#include +#if defined(_SIZE_T_) || defined(SIGLOST) +#include +#endif +#endif +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); +#endif + +#if defined (vax) +#if !defined (ultrix) +#include +#if defined (BSD) +#if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +#else +#if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#endif +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#else +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname un; + uname (&un); + printf ("vax-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("vax-dec-ultrix\n"); exit (0); +#endif +#endif +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname *un; + uname (&un); + printf ("mips-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("mips-dec-ultrix\n"); exit (0); +#endif +#endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`"$dummy"` && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. +test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; } + echo "$0: unable to guess system type" >&2 -case "$UNAME_MACHINE:$UNAME_SYSTEM" in +case $UNAME_MACHINE:$UNAME_SYSTEM in mips:Linux | mips64:Linux) # If we got here on MIPS GNU/Linux, output extra information. cat >&2 <&2 <&2 exit 1 ;; *local*) @@ -110,1223 +119,1173 @@ exit 1;; esac -# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). -# Here we must recognize all the valid KERNEL-OS combinations. -maybe_os=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` -case $maybe_os in - nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ - linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ - knetbsd*-gnu* | netbsd*-gnu* | netbsd*-eabi* | \ - kopensolaris*-gnu* | cloudabi*-eabi* | \ - storm-chaos* | os2-emx* | rtmk-nova*) - os=-$maybe_os - basic_machine=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` - ;; - android-linux) - os=-linux-android - basic_machine=`echo "$1" | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown - ;; - *) - basic_machine=`echo "$1" | sed 's/-[^-]*$//'` - if [ "$basic_machine" != "$1" ] - then os=`echo "$1" | sed 's/.*-/-/'` - else os=; fi - ;; -esac - -### Let's recognize common machines as not being operating systems so -### that things like config.sub decstation-3100 work. We also -### recognize some manufacturers as not being operating systems, so we -### can provide default operating systems below. -case $os in - -sun*os*) - # Prevent following clause from handling this invalid input. - ;; - -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ - -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ - -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ - -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ - -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ - -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray | -microblaze*) - os= - basic_machine=$1 - ;; - -bluegene*) - os=-cnk - ;; - -sim | -cisco | -oki | -wec | -winbond) - os= - basic_machine=$1 - ;; - -scout) - ;; - -wrs) - os=-vxworks - basic_machine=$1 - ;; - -chorusos*) - os=-chorusos - basic_machine=$1 - ;; - -chorusrdb) - os=-chorusrdb - basic_machine=$1 - ;; - -hiux*) - os=-hiuxwe2 - ;; - -sco6) - os=-sco5v6 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -sco5) - os=-sco3.2v5 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -sco4) - os=-sco3.2v4 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2v[4-9]*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -sco5v6*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -sco*) - os=-sco3.2v2 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -udk*) - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -isc) - os=-isc2.2 - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -clix*) - basic_machine=clipper-intergraph - ;; - -isc*) - basic_machine=`echo "$1" | sed -e 's/86-.*/86-pc/'` - ;; - -lynx*178) - os=-lynxos178 - ;; - -lynx*5) - os=-lynxos5 +# Split fields of configuration type +# shellcheck disable=SC2162 +IFS="-" read field1 field2 field3 field4 <&2 + exit 1 ;; - -lynx*) - os=-lynxos + *-*-*-*) + basic_machine=$field1-$field2 + basic_os=$field3-$field4 ;; - -ptx*) - basic_machine=`echo "$1" | sed -e 's/86-.*/86-sequent/'` + *-*-*) + # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two + # parts + maybe_os=$field2-$field3 + case $maybe_os in + nto-qnx* | linux-* | uclinux-uclibc* \ + | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ + | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ + | storm-chaos* | os2-emx* | rtmk-nova*) + basic_machine=$field1 + basic_os=$maybe_os + ;; + android-linux) + basic_machine=$field1-unknown + basic_os=linux-android + ;; + *) + basic_machine=$field1-$field2 + basic_os=$field3 + ;; + esac ;; - -psos*) - os=-psos + *-*) + # A lone config we happen to match not fitting any pattern + case $field1-$field2 in + decstation-3100) + basic_machine=mips-dec + basic_os= + ;; + *-*) + # Second component is usually, but not always the OS + case $field2 in + # Prevent following clause from handling this valid os + sun*os*) + basic_machine=$field1 + basic_os=$field2 + ;; + # Manufacturers + dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ + | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ + | unicom* | ibm* | next | hp | isi* | apollo | altos* \ + | convergent* | ncr* | news | 32* | 3600* | 3100* \ + | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ + | ultra | tti* | harris | dolphin | highlevel | gould \ + | cbm | ns | masscomp | apple | axis | knuth | cray \ + | microblaze* | sim | cisco \ + | oki | wec | wrs | winbond) + basic_machine=$field1-$field2 + basic_os= + ;; + *) + basic_machine=$field1 + basic_os=$field2 + ;; + esac + ;; + esac ;; - -mint | -mint[0-9]*) - basic_machine=m68k-atari - os=-mint + *) + # Convert single-component short-hands not valid as part of + # multi-component configurations. + case $field1 in + 386bsd) + basic_machine=i386-pc + basic_os=bsd + ;; + a29khif) + basic_machine=a29k-amd + basic_os=udi + ;; + adobe68k) + basic_machine=m68010-adobe + basic_os=scout + ;; + alliant) + basic_machine=fx80-alliant + basic_os= + ;; + altos | altos3068) + basic_machine=m68k-altos + basic_os= + ;; + am29k) + basic_machine=a29k-none + basic_os=bsd + ;; + amdahl) + basic_machine=580-amdahl + basic_os=sysv + ;; + amiga) + basic_machine=m68k-unknown + basic_os= + ;; + amigaos | amigados) + basic_machine=m68k-unknown + basic_os=amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + basic_os=sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + basic_os=sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + basic_os=bsd + ;; + aros) + basic_machine=i386-pc + basic_os=aros + ;; + aux) + basic_machine=m68k-apple + basic_os=aux + ;; + balance) + basic_machine=ns32k-sequent + basic_os=dynix + ;; + blackfin) + basic_machine=bfin-unknown + basic_os=linux + ;; + cegcc) + basic_machine=arm-unknown + basic_os=cegcc + ;; + convex-c1) + basic_machine=c1-convex + basic_os=bsd + ;; + convex-c2) + basic_machine=c2-convex + basic_os=bsd + ;; + convex-c32) + basic_machine=c32-convex + basic_os=bsd + ;; + convex-c34) + basic_machine=c34-convex + basic_os=bsd + ;; + convex-c38) + basic_machine=c38-convex + basic_os=bsd + ;; + cray) + basic_machine=j90-cray + basic_os=unicos + ;; + crds | unos) + basic_machine=m68k-crds + basic_os= + ;; + da30) + basic_machine=m68k-da30 + basic_os= + ;; + decstation | pmax | pmin | dec3100 | decstatn) + basic_machine=mips-dec + basic_os= + ;; + delta88) + basic_machine=m88k-motorola + basic_os=sysv3 + ;; + dicos) + basic_machine=i686-pc + basic_os=dicos + ;; + djgpp) + basic_machine=i586-pc + basic_os=msdosdjgpp + ;; + ebmon29k) + basic_machine=a29k-amd + basic_os=ebmon + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + basic_os=ose + ;; + gmicro) + basic_machine=tron-gmicro + basic_os=sysv + ;; + go32) + basic_machine=i386-pc + basic_os=go32 + ;; + h8300hms) + basic_machine=h8300-hitachi + basic_os=hms + ;; + h8300xray) + basic_machine=h8300-hitachi + basic_os=xray + ;; + h8500hms) + basic_machine=h8500-hitachi + basic_os=hms + ;; + harris) + basic_machine=m88k-harris + basic_os=sysv3 + ;; + hp300 | hp300hpux) + basic_machine=m68k-hp + basic_os=hpux + ;; + hp300bsd) + basic_machine=m68k-hp + basic_os=bsd + ;; + hppaosf) + basic_machine=hppa1.1-hp + basic_os=osf + ;; + hppro) + basic_machine=hppa1.1-hp + basic_os=proelf + ;; + i386mach) + basic_machine=i386-mach + basic_os=mach + ;; + isi68 | isi) + basic_machine=m68k-isi + basic_os=sysv + ;; + m68knommu) + basic_machine=m68k-unknown + basic_os=linux + ;; + magnum | m3230) + basic_machine=mips-mips + basic_os=sysv + ;; + merlin) + basic_machine=ns32k-utek + basic_os=sysv + ;; + mingw64) + basic_machine=x86_64-pc + basic_os=mingw64 + ;; + mingw32) + basic_machine=i686-pc + basic_os=mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + basic_os=mingw32ce + ;; + monitor) + basic_machine=m68k-rom68k + basic_os=coff + ;; + morphos) + basic_machine=powerpc-unknown + basic_os=morphos + ;; + moxiebox) + basic_machine=moxie-unknown + basic_os=moxiebox + ;; + msdos) + basic_machine=i386-pc + basic_os=msdos + ;; + msys) + basic_machine=i686-pc + basic_os=msys + ;; + mvs) + basic_machine=i370-ibm + basic_os=mvs + ;; + nacl) + basic_machine=le32-unknown + basic_os=nacl + ;; + ncr3000) + basic_machine=i486-ncr + basic_os=sysv4 + ;; + netbsd386) + basic_machine=i386-pc + basic_os=netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + basic_os=linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + basic_os=newsos + ;; + news1000) + basic_machine=m68030-sony + basic_os=newsos + ;; + necv70) + basic_machine=v70-nec + basic_os=sysv + ;; + nh3000) + basic_machine=m68k-harris + basic_os=cxux + ;; + nh[45]000) + basic_machine=m88k-harris + basic_os=cxux + ;; + nindy960) + basic_machine=i960-intel + basic_os=nindy + ;; + mon960) + basic_machine=i960-intel + basic_os=mon960 + ;; + nonstopux) + basic_machine=mips-compaq + basic_os=nonstopux + ;; + os400) + basic_machine=powerpc-ibm + basic_os=os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + basic_os=ose + ;; + os68k) + basic_machine=m68k-none + basic_os=os68k + ;; + paragon) + basic_machine=i860-intel + basic_os=osf + ;; + parisc) + basic_machine=hppa-unknown + basic_os=linux + ;; + psp) + basic_machine=mipsallegrexel-sony + basic_os=psp + ;; + pw32) + basic_machine=i586-unknown + basic_os=pw32 + ;; + rdos | rdos64) + basic_machine=x86_64-pc + basic_os=rdos + ;; + rdos32) + basic_machine=i386-pc + basic_os=rdos + ;; + rom68k) + basic_machine=m68k-rom68k + basic_os=coff + ;; + sa29200) + basic_machine=a29k-amd + basic_os=udi + ;; + sei) + basic_machine=mips-sei + basic_os=seiux + ;; + sequent) + basic_machine=i386-sequent + basic_os= + ;; + sps7) + basic_machine=m68k-bull + basic_os=sysv2 + ;; + st2000) + basic_machine=m68k-tandem + basic_os= + ;; + stratus) + basic_machine=i860-stratus + basic_os=sysv4 + ;; + sun2) + basic_machine=m68000-sun + basic_os= + ;; + sun2os3) + basic_machine=m68000-sun + basic_os=sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + basic_os=sunos4 + ;; + sun3) + basic_machine=m68k-sun + basic_os= + ;; + sun3os3) + basic_machine=m68k-sun + basic_os=sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + basic_os=sunos4 + ;; + sun4) + basic_machine=sparc-sun + basic_os= + ;; + sun4os3) + basic_machine=sparc-sun + basic_os=sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + basic_os=sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + basic_os=solaris2 + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + basic_os= + ;; + sv1) + basic_machine=sv1-cray + basic_os=unicos + ;; + symmetry) + basic_machine=i386-sequent + basic_os=dynix + ;; + t3e) + basic_machine=alphaev5-cray + basic_os=unicos + ;; + t90) + basic_machine=t90-cray + basic_os=unicos + ;; + toad1) + basic_machine=pdp10-xkl + basic_os=tops20 + ;; + tpf) + basic_machine=s390x-ibm + basic_os=tpf + ;; + udi29k) + basic_machine=a29k-amd + basic_os=udi + ;; + ultra3) + basic_machine=a29k-nyu + basic_os=sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + basic_os=none + ;; + vaxv) + basic_machine=vax-dec + basic_os=sysv + ;; + vms) + basic_machine=vax-dec + basic_os=vms + ;; + vsta) + basic_machine=i386-pc + basic_os=vsta + ;; + vxworks960) + basic_machine=i960-wrs + basic_os=vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + basic_os=vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + basic_os=vxworks + ;; + xbox) + basic_machine=i686-pc + basic_os=mingw32 + ;; + ymp) + basic_machine=ymp-cray + basic_os=unicos + ;; + *) + basic_machine=$1 + basic_os= + ;; + esac ;; esac -# Decode aliases for certain CPU-COMPANY combinations. +# Decode 1-component or ad-hoc basic machines case $basic_machine in - # Recognize the basic CPU types without company name. - # Some are omitted here because they have special meanings below. - 1750a | 580 \ - | a29k \ - | aarch64 | aarch64_be \ - | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ - | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | am33_2.0 \ - | arc | arceb \ - | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ - | avr | avr32 \ - | ba \ - | be32 | be64 \ - | bfin \ - | c4x | c8051 | clipper \ - | d10v | d30v | dlx | dsp16xx \ - | e2k | epiphany \ - | fido | fr30 | frv | ft32 \ - | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ - | hexagon \ - | i370 | i860 | i960 | ia16 | ia64 \ - | ip2k | iq2000 \ - | k1om \ - | le32 | le64 \ - | lm32 \ - | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ - | mips | mipsbe | mipseb | mipsel | mipsle \ - | mips16 \ - | mips64 | mips64el \ - | mips64octeon | mips64octeonel \ - | mips64orion | mips64orionel \ - | mips64r5900 | mips64r5900el \ - | mips64vr | mips64vrel \ - | mips64vr4100 | mips64vr4100el \ - | mips64vr4300 | mips64vr4300el \ - | mips64vr5000 | mips64vr5000el \ - | mips64vr5900 | mips64vr5900el \ - | mipsisa32 | mipsisa32el \ - | mipsisa32r2 | mipsisa32r2el \ - | mipsisa32r6 | mipsisa32r6el \ - | mipsisa64 | mipsisa64el \ - | mipsisa64r2 | mipsisa64r2el \ - | mipsisa64r6 | mipsisa64r6el \ - | mipsisa64sb1 | mipsisa64sb1el \ - | mipsisa64sr71k | mipsisa64sr71kel \ - | mipsr5900 | mipsr5900el \ - | mipstx39 | mipstx39el \ - | mn10200 | mn10300 \ - | moxie \ - | mt \ - | msp430 \ - | nds32 | nds32le | nds32be \ - | nios | nios2 | nios2eb | nios2el \ - | ns16k | ns32k \ - | open8 | or1k | or1knd | or32 \ - | pdp10 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle \ - | pru \ - | pyramid \ - | riscv32 | riscv64 \ - | rl78 | rx \ - | score \ - | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ - | sh64 | sh64le \ - | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ - | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu \ - | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ - | ubicom32 \ - | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ - | visium \ - | wasm32 \ - | x86 | xc16x | xstormy16 | xtensa \ - | z8k | z80) - basic_machine=$basic_machine-unknown - ;; - c54x) - basic_machine=tic54x-unknown - ;; - c55x) - basic_machine=tic55x-unknown - ;; - c6x) - basic_machine=tic6x-unknown - ;; - leon|leon[3-9]) - basic_machine=sparc-$basic_machine - ;; - m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip) - basic_machine=$basic_machine-unknown - os=-none + # Here we handle the default manufacturer of certain CPU types. It is in + # some cases the only manufacturer, in others, it is the most popular. + w89k) + cpu=hppa1.1 + vendor=winbond ;; - m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65) + op50n) + cpu=hppa1.1 + vendor=oki ;; - ms1) - basic_machine=mt-unknown + op60c) + cpu=hppa1.1 + vendor=oki ;; - - strongarm | thumb | xscale) - basic_machine=arm-unknown + ibm*) + cpu=i370 + vendor=ibm ;; - xgate) - basic_machine=$basic_machine-unknown - os=-none + orion105) + cpu=clipper + vendor=highlevel ;; - xscaleeb) - basic_machine=armeb-unknown + mac | mpw | mac-mpw) + cpu=m68k + vendor=apple ;; - - xscaleel) - basic_machine=armel-unknown + pmac | pmac-mpw) + cpu=powerpc + vendor=apple ;; - # We use `pc' rather than `unknown' - # because (1) that's what they normally are, and - # (2) the word "unknown" tends to confuse beginning users. - i*86 | x86_64) - basic_machine=$basic_machine-pc - ;; - # Object if more than one company name word. - *-*-*) - echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2 - exit 1 - ;; - # Recognize the basic CPU types with company name. - 580-* \ - | a29k-* \ - | aarch64-* | aarch64_be-* \ - | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ - | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ - | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \ - | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* | avr32-* \ - | ba-* \ - | be32-* | be64-* \ - | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* \ - | c8051-* | clipper-* | craynv-* | cydra-* \ - | d10v-* | d30v-* | dlx-* \ - | e2k-* | elxsi-* \ - | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ - | h8300-* | h8500-* \ - | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ - | hexagon-* \ - | i*86-* | i860-* | i960-* | ia16-* | ia64-* \ - | ip2k-* | iq2000-* \ - | k1om-* \ - | le32-* | le64-* \ - | lm32-* \ - | m32c-* | m32r-* | m32rle-* \ - | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ - | microblaze-* | microblazeel-* \ - | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ - | mips16-* \ - | mips64-* | mips64el-* \ - | mips64octeon-* | mips64octeonel-* \ - | mips64orion-* | mips64orionel-* \ - | mips64r5900-* | mips64r5900el-* \ - | mips64vr-* | mips64vrel-* \ - | mips64vr4100-* | mips64vr4100el-* \ - | mips64vr4300-* | mips64vr4300el-* \ - | mips64vr5000-* | mips64vr5000el-* \ - | mips64vr5900-* | mips64vr5900el-* \ - | mipsisa32-* | mipsisa32el-* \ - | mipsisa32r2-* | mipsisa32r2el-* \ - | mipsisa32r6-* | mipsisa32r6el-* \ - | mipsisa64-* | mipsisa64el-* \ - | mipsisa64r2-* | mipsisa64r2el-* \ - | mipsisa64r6-* | mipsisa64r6el-* \ - | mipsisa64sb1-* | mipsisa64sb1el-* \ - | mipsisa64sr71k-* | mipsisa64sr71kel-* \ - | mipsr5900-* | mipsr5900el-* \ - | mipstx39-* | mipstx39el-* \ - | mmix-* \ - | mt-* \ - | msp430-* \ - | nds32-* | nds32le-* | nds32be-* \ - | nios-* | nios2-* | nios2eb-* | nios2el-* \ - | none-* | np1-* | ns16k-* | ns32k-* \ - | open8-* \ - | or1k*-* \ - | orion-* \ - | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ - | pru-* \ - | pyramid-* \ - | riscv32-* | riscv64-* \ - | rl78-* | romp-* | rs6000-* | rx-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ - | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ - | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \ - | tahoe-* \ - | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ - | tile*-* \ - | tron-* \ - | ubicom32-* \ - | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ - | vax-* \ - | visium-* \ - | wasm32-* \ - | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* \ - | xstormy16-* | xtensa*-* \ - | ymp-* \ - | z8k-* | z80-*) - ;; - # Recognize the basic CPU types without company name, with glob match. - xtensa*) - basic_machine=$basic_machine-unknown - ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. - 386bsd) - basic_machine=i386-pc - os=-bsd - ;; 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att + cpu=m68000 + vendor=att ;; 3b*) - basic_machine=we32k-att - ;; - a29khif) - basic_machine=a29k-amd - os=-udi - ;; - abacus) - basic_machine=abacus-unknown - ;; - adobe68k) - basic_machine=m68010-adobe - os=-scout - ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; - am29k) - basic_machine=a29k-none - os=-bsd - ;; - amd64) - basic_machine=x86_64-pc - ;; - amd64-*) - basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; - amdahl) - basic_machine=580-amdahl - os=-sysv - ;; - amiga | amiga-*) - basic_machine=m68k-unknown - ;; - amigaos | amigados) - basic_machine=m68k-unknown - os=-amigaos - ;; - amigaunix | amix) - basic_machine=m68k-unknown - os=-sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=-sysv - ;; - apollo68bsd) - basic_machine=m68k-apollo - os=-bsd - ;; - aros) - basic_machine=i386-pc - os=-aros - ;; - asmjs) - basic_machine=asmjs-unknown - ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; - balance) - basic_machine=ns32k-sequent - os=-dynix - ;; - blackfin) - basic_machine=bfin-unknown - os=-linux - ;; - blackfin-*) - basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'` - os=-linux + cpu=we32k + vendor=att ;; bluegene*) - basic_machine=powerpc-ibm - os=-cnk - ;; - c54x-*) - basic_machine=tic54x-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; - c55x-*) - basic_machine=tic55x-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; - c6x-*) - basic_machine=tic6x-`echo "$basic_machine" | sed 's/^[^-]*-//'` - ;; - c90) - basic_machine=c90-cray - os=-unicos - ;; - cegcc) - basic_machine=arm-unknown - os=-cegcc - ;; - convex-c1) - basic_machine=c1-convex - os=-bsd - ;; - convex-c2) - basic_machine=c2-convex - os=-bsd - ;; - convex-c32) - basic_machine=c32-convex - os=-bsd - ;; - convex-c34) - basic_machine=c34-convex - os=-bsd - ;; - convex-c38) - basic_machine=c38-convex - os=-bsd - ;; - cray | j90) - basic_machine=j90-cray - os=-unicos - ;; - craynv) - basic_machine=craynv-cray - os=-unicosmp - ;; - cr16 | cr16-*) - basic_machine=cr16-unknown - os=-elf - ;; - crds | unos) - basic_machine=m68k-crds - ;; - crisv32 | crisv32-* | etraxfs*) - basic_machine=crisv32-axis - ;; - cris | cris-* | etrax*) - basic_machine=cris-axis - ;; - crx) - basic_machine=crx-unknown - os=-elf - ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec + cpu=powerpc + vendor=ibm + basic_os=cnk ;; decsystem10* | dec10*) - basic_machine=pdp10-dec - os=-tops10 + cpu=pdp10 + vendor=dec + basic_os=tops10 ;; decsystem20* | dec20*) - basic_machine=pdp10-dec - os=-tops20 + cpu=pdp10 + vendor=dec + basic_os=tops20 ;; delta | 3300 | motorola-3300 | motorola-delta \ | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - delta88) - basic_machine=m88k-motorola - os=-sysv3 - ;; - dicos) - basic_machine=i686-pc - os=-dicos - ;; - djgpp) - basic_machine=i586-pc - os=-msdosdjgpp - ;; - dpx20 | dpx20-*) - basic_machine=rs6000-bull - os=-bosx + cpu=m68k + vendor=motorola ;; dpx2*) - basic_machine=m68k-bull - os=-sysv3 - ;; - e500v[12]) - basic_machine=powerpc-unknown - os=$os"spe" - ;; - e500v[12]-*) - basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'` - os=$os"spe" - ;; - ebmon29k) - basic_machine=a29k-amd - os=-ebmon - ;; - elxsi) - basic_machine=elxsi-elxsi - os=-bsd + cpu=m68k + vendor=bull + basic_os=sysv3 ;; encore | umax | mmax) - basic_machine=ns32k-encore + cpu=ns32k + vendor=encore ;; - es1800 | OSE68k | ose68k | ose | OSE) - basic_machine=m68k-ericsson - os=-ose + elxsi) + cpu=elxsi + vendor=elxsi + basic_os=${basic_os:-bsd} ;; fx2800) - basic_machine=i860-alliant + cpu=i860 + vendor=alliant ;; genix) - basic_machine=ns32k-ns - ;; - gmicro) - basic_machine=tron-gmicro - os=-sysv - ;; - go32) - basic_machine=i386-pc - os=-go32 + cpu=ns32k + vendor=ns ;; h3050r* | hiux*) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - h8300hms) - basic_machine=h8300-hitachi - os=-hms - ;; - h8300xray) - basic_machine=h8300-hitachi - os=-xray - ;; - h8500hms) - basic_machine=h8500-hitachi - os=-hms - ;; - harris) - basic_machine=m88k-harris - os=-sysv3 - ;; - hp300-*) - basic_machine=m68k-hp - ;; - hp300bsd) - basic_machine=m68k-hp - os=-bsd - ;; - hp300hpux) - basic_machine=m68k-hp - os=-hpux + cpu=hppa1.1 + vendor=hitachi + basic_os=hiuxwe2 ;; hp3k9[0-9][0-9] | hp9[0-9][0-9]) - basic_machine=hppa1.0-hp + cpu=hppa1.0 + vendor=hp ;; hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp + cpu=m68000 + vendor=hp ;; hp9k3[2-9][0-9]) - basic_machine=m68k-hp + cpu=m68k + vendor=hp ;; hp9k6[0-9][0-9] | hp6[0-9][0-9]) - basic_machine=hppa1.0-hp + cpu=hppa1.0 + vendor=hp ;; hp9k7[0-79][0-9] | hp7[0-79][0-9]) - basic_machine=hppa1.1-hp + cpu=hppa1.1 + vendor=hp ;; hp9k78[0-9] | hp78[0-9]) # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp + cpu=hppa1.1 + vendor=hp ;; hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) # FIXME: really hppa2.0-hp - basic_machine=hppa1.1-hp + cpu=hppa1.1 + vendor=hp ;; hp9k8[0-9][13679] | hp8[0-9][13679]) - basic_machine=hppa1.1-hp + cpu=hppa1.1 + vendor=hp ;; hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hppaosf) - basic_machine=hppa1.1-hp - os=-osf - ;; - hppro) - basic_machine=hppa1.1-hp - os=-proelf - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm + cpu=hppa1.0 + vendor=hp ;; i*86v32) - basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` - os=-sysv32 + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + basic_os=sysv32 ;; i*86v4*) - basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` - os=-sysv4 + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + basic_os=sysv4 ;; i*86v) - basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` - os=-sysv + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + basic_os=sysv ;; i*86sol2) - basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'` - os=-solaris2 - ;; - i386mach) - basic_machine=i386-mach - os=-mach - ;; - vsta) - basic_machine=i386-unknown - os=-vsta + cpu=`echo "$1" | sed -e 's/86.*/86/'` + vendor=pc + basic_os=solaris2 + ;; + j90 | j90-cray) + cpu=j90 + vendor=cray + basic_os=${basic_os:-unicos} ;; iris | iris4d) - basic_machine=mips-sgi - case $os in - -irix*) + cpu=mips + vendor=sgi + case $basic_os in + irix*) ;; *) - os=-irix4 + basic_os=irix4 ;; esac ;; - isi68 | isi) - basic_machine=m68k-isi - os=-sysv - ;; - leon-*|leon[3-9]-*) - basic_machine=sparc-`echo "$basic_machine" | sed 's/-.*//'` - ;; - m68knommu) - basic_machine=m68k-unknown - os=-linux - ;; - m68knommu-*) - basic_machine=m68k-`echo "$basic_machine" | sed 's/^[^-]*-//'` - os=-linux - ;; - magnum | m3230) - basic_machine=mips-mips - os=-sysv - ;; - merlin) - basic_machine=ns32k-utek - os=-sysv - ;; - microblaze*) - basic_machine=microblaze-xilinx - ;; - mingw64) - basic_machine=x86_64-pc - os=-mingw64 - ;; - mingw32) - basic_machine=i686-pc - os=-mingw32 - ;; - mingw32ce) - basic_machine=arm-unknown - os=-mingw32ce - ;; miniframe) - basic_machine=m68000-convergent - ;; - *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) - basic_machine=m68k-atari - os=-mint - ;; - mips3*-*) - basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo "$basic_machine" | sed -e 's/mips3/mips64/'`-unknown - ;; - monitor) - basic_machine=m68k-rom68k - os=-coff - ;; - morphos) - basic_machine=powerpc-unknown - os=-morphos - ;; - moxiebox) - basic_machine=moxie-unknown - os=-moxiebox - ;; - msdos) - basic_machine=i386-pc - os=-msdos + cpu=m68000 + vendor=convergent ;; - ms1-*) - basic_machine=`echo "$basic_machine" | sed -e 's/ms1-/mt-/'` - ;; - msys) - basic_machine=i686-pc - os=-msys - ;; - mvs) - basic_machine=i370-ibm - os=-mvs - ;; - nacl) - basic_machine=le32-unknown - os=-nacl - ;; - ncr3000) - basic_machine=i486-ncr - os=-sysv4 - ;; - netbsd386) - basic_machine=i386-unknown - os=-netbsd - ;; - netwinder) - basic_machine=armv4l-rebel - os=-linux - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - os=-newsos - ;; - news1000) - basic_machine=m68030-sony - os=-newsos + *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) + cpu=m68k + vendor=atari + basic_os=mint ;; news-3600 | risc-news) - basic_machine=mips-sony - os=-newsos - ;; - necv70) - basic_machine=v70-nec - os=-sysv + cpu=mips + vendor=sony + basic_os=newsos ;; next | m*-next) - basic_machine=m68k-next - case $os in - -nextstep* ) + cpu=m68k + vendor=next + case $basic_os in + openstep*) + ;; + nextstep*) ;; - -ns2*) - os=-nextstep2 + ns2*) + basic_os=nextstep2 ;; *) - os=-nextstep3 + basic_os=nextstep3 ;; esac ;; - nh3000) - basic_machine=m68k-harris - os=-cxux - ;; - nh[45]000) - basic_machine=m88k-harris - os=-cxux - ;; - nindy960) - basic_machine=i960-intel - os=-nindy - ;; - mon960) - basic_machine=i960-intel - os=-mon960 - ;; - nonstopux) - basic_machine=mips-compaq - os=-nonstopux - ;; np1) - basic_machine=np1-gould - ;; - neo-tandem) - basic_machine=neo-tandem - ;; - nse-tandem) - basic_machine=nse-tandem - ;; - nsr-tandem) - basic_machine=nsr-tandem - ;; - nsv-tandem) - basic_machine=nsv-tandem - ;; - nsx-tandem) - basic_machine=nsx-tandem + cpu=np1 + vendor=gould ;; op50n-* | op60c-*) - basic_machine=hppa1.1-oki - os=-proelf - ;; - openrisc | openrisc-*) - basic_machine=or32-unknown - ;; - os400) - basic_machine=powerpc-ibm - os=-os400 - ;; - OSE68000 | ose68000) - basic_machine=m68000-ericsson - os=-ose - ;; - os68k) - basic_machine=m68k-none - os=-os68k + cpu=hppa1.1 + vendor=oki + basic_os=proelf ;; pa-hitachi) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - paragon) - basic_machine=i860-intel - os=-osf - ;; - parisc) - basic_machine=hppa-unknown - os=-linux - ;; - parisc-*) - basic_machine=hppa-`echo "$basic_machine" | sed 's/^[^-]*-//'` - os=-linux + cpu=hppa1.1 + vendor=hitachi + basic_os=hiuxwe2 ;; pbd) - basic_machine=sparc-tti + cpu=sparc + vendor=tti ;; pbb) - basic_machine=m68k-tti + cpu=m68k + vendor=tti ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 + pc532) + cpu=ns32k + vendor=pc532 ;; - pc98) - basic_machine=i386-pc + pn) + cpu=pn + vendor=gould ;; - pc98-*) - basic_machine=i386-`echo "$basic_machine" | sed 's/^[^-]*-//'` + power) + cpu=power + vendor=ibm ;; - pentium | p5 | k5 | k6 | nexgen | viac3) - basic_machine=i586-pc + ps2) + cpu=i386 + vendor=ibm ;; - pentiumpro | p6 | 6x86 | athlon | athlon_*) - basic_machine=i686-pc + rm[46]00) + cpu=mips + vendor=siemens ;; - pentiumii | pentium2 | pentiumiii | pentium3) - basic_machine=i686-pc + rtpc | rtpc-*) + cpu=romp + vendor=ibm ;; - pentium4) - basic_machine=i786-pc + sde) + cpu=mipsisa32 + vendor=sde + basic_os=${basic_os:-elf} ;; - pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) - basic_machine=i586-`echo "$basic_machine" | sed 's/^[^-]*-//'` + simso-wrs) + cpu=sparclite + vendor=wrs + basic_os=vxworks ;; - pentiumpro-* | p6-* | 6x86-* | athlon-*) - basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'` + tower | tower-32) + cpu=m68k + vendor=ncr ;; - pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) - basic_machine=i686-`echo "$basic_machine" | sed 's/^[^-]*-//'` + vpp*|vx|vx-*) + cpu=f301 + vendor=fujitsu ;; - pentium4-*) - basic_machine=i786-`echo "$basic_machine" | sed 's/^[^-]*-//'` + w65) + cpu=w65 + vendor=wdc ;; - pn) - basic_machine=pn-gould + w89k-*) + cpu=hppa1.1 + vendor=winbond + basic_os=proelf ;; - power) basic_machine=power-ibm + none) + cpu=none + vendor=none ;; - ppc | ppcbe) basic_machine=powerpc-unknown + leon|leon[3-9]) + cpu=sparc + vendor=$basic_machine ;; - ppc-* | ppcbe-*) - basic_machine=powerpc-`echo "$basic_machine" | sed 's/^[^-]*-//'` + leon-*|leon[3-9]-*) + cpu=sparc + vendor=`echo "$basic_machine" | sed 's/-.*//'` ;; - ppcle | powerpclittle) - basic_machine=powerpcle-unknown + + *-*) + # shellcheck disable=SC2162 + IFS="-" read cpu vendor <&2 - exit 1 + # Recognize the canonical CPU types that are allowed with any + # company name. + case $cpu in + 1750a | 580 \ + | a29k \ + | aarch64 | aarch64_be \ + | abacus \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \ + | alphapca5[67] | alpha64pca5[67] \ + | am33_2.0 \ + | amdgcn \ + | arc | arceb | arc32 | arc64 \ + | arm | arm[lb]e | arme[lb] | armv* \ + | avr | avr32 \ + | asmjs \ + | ba \ + | be32 | be64 \ + | bfin | bpf | bs2000 \ + | c[123]* | c30 | [cjt]90 | c4x \ + | c8051 | clipper | craynv | csky | cydra \ + | d10v | d30v | dlx | dsp16xx \ + | e2k | elxsi | epiphany \ + | f30[01] | f700 | fido | fr30 | frv | ft32 | fx80 \ + | h8300 | h8500 \ + | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ + | i370 | i*86 | i860 | i960 | ia16 | ia64 \ + | ip2k | iq2000 \ + | k1om \ + | le32 | le64 \ + | lm32 \ + | loongarch32 | loongarch64 | loongarchx32 \ + | m32c | m32r | m32rle \ + | m5200 | m68000 | m680[012346]0 | m68360 | m683?2 | m68k \ + | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \ + | m88110 | m88k | maxq | mb | mcore | mep | metag \ + | microblaze | microblazeel \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64eb | mips64el \ + | mips64octeon | mips64octeonel \ + | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa32r3 | mipsisa32r3el \ + | mipsisa32r5 | mipsisa32r5el \ + | mipsisa32r6 | mipsisa32r6el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64r3 | mipsisa64r3el \ + | mipsisa64r5 | mipsisa64r5el \ + | mipsisa64r6 | mipsisa64r6el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ + | mipstx39 | mipstx39el \ + | mmix \ + | mn10200 | mn10300 \ + | moxie \ + | mt \ + | msp430 \ + | nds32 | nds32le | nds32be \ + | nfp \ + | nios | nios2 | nios2eb | nios2el \ + | none | np1 | ns16k | ns32k | nvptx \ + | open8 \ + | or1k* \ + | or32 \ + | orion \ + | picochip \ + | pdp10 | pdp11 | pj | pjl | pn | power \ + | powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \ + | pru \ + | pyramid \ + | riscv | riscv32 | riscv32be | riscv64 | riscv64be \ + | rl78 | romp | rs6000 | rx \ + | s390 | s390x \ + | score \ + | sh | shl \ + | sh[1234] | sh[24]a | sh[24]ae[lb] | sh[23]e | she[lb] | sh[lb]e \ + | sh[1234]e[lb] | sh[12345][lb]e | sh[23]ele | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet \ + | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v | sv1 | sx* \ + | spu \ + | tahoe \ + | thumbv7* \ + | tic30 | tic4x | tic54x | tic55x | tic6x | tic80 \ + | tron \ + | ubicom32 \ + | v70 | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \ + | vax \ + | visium \ + | w65 \ + | wasm32 | wasm64 \ + | we32k \ + | x86 | x86_64 | xc16x | xgate | xps100 \ + | xstormy16 | xtensa* \ + | ymp \ + | z8k | z80) + ;; + + *) + echo Invalid configuration \`"$1"\': machine \`"$cpu-$vendor"\' not recognized 1>&2 + exit 1 + ;; + esac ;; esac # Here we canonicalize certain aliases for manufacturers. -case $basic_machine in - *-digital*) - basic_machine=`echo "$basic_machine" | sed 's/digital.*/dec/'` +case $vendor in + digital*) + vendor=dec ;; - *-commodore*) - basic_machine=`echo "$basic_machine" | sed 's/commodore.*/cbm/'` + commodore*) + vendor=cbm ;; *) ;; @@ -1334,203 +1293,213 @@ # Decode manufacturer-specific aliases for certain operating systems. -if [ x"$os" != x"" ] +if test x$basic_os != x then + +# First recognize some ad-hoc caes, or perhaps split kernel-os, or else just +# set os. +case $basic_os in + gnu/linux*) + kernel=linux + os=`echo "$basic_os" | sed -e 's|gnu/linux|gnu|'` + ;; + os2-emx) + kernel=os2 + os=`echo "$basic_os" | sed -e 's|os2-emx|emx|'` + ;; + nto-qnx*) + kernel=nto + os=`echo "$basic_os" | sed -e 's|nto-qnx|qnx|'` + ;; + *-*) + # shellcheck disable=SC2162 + IFS="-" read kernel os <&2 - exit 1 + # No normalization, but not necessarily accepted, that comes below. ;; esac + else # Here we handle the default operating systems that come with various machines. @@ -1543,254 +1512,357 @@ # will signal an error saying that MANUFACTURER isn't an operating # system, and we'll never get to this point. -case $basic_machine in +kernel= +case $cpu-$vendor in score-*) - os=-elf + os=elf ;; spu-*) - os=-elf + os=elf ;; *-acorn) - os=-riscix1.2 + os=riscix1.2 ;; arm*-rebel) - os=-linux + kernel=linux + os=gnu ;; arm*-semi) - os=-aout + os=aout ;; c4x-* | tic4x-*) - os=-coff + os=coff ;; c8051-*) - os=-elf + os=elf + ;; + clipper-intergraph) + os=clix ;; hexagon-*) - os=-elf + os=elf ;; tic54x-*) - os=-coff + os=coff ;; tic55x-*) - os=-coff + os=coff ;; tic6x-*) - os=-coff + os=coff ;; # This must come before the *-dec entry. pdp10-*) - os=-tops20 + os=tops20 ;; pdp11-*) - os=-none + os=none ;; *-dec | vax-*) - os=-ultrix4.2 + os=ultrix4.2 ;; m68*-apollo) - os=-domain + os=domain ;; i386-sun) - os=-sunos4.0.2 + os=sunos4.0.2 ;; m68000-sun) - os=-sunos3 + os=sunos3 ;; m68*-cisco) - os=-aout + os=aout ;; mep-*) - os=-elf + os=elf ;; mips*-cisco) - os=-elf + os=elf ;; mips*-*) - os=-elf + os=elf ;; or32-*) - os=-coff + os=coff ;; *-tti) # must be before sparc entry or we get the wrong os. - os=-sysv3 + os=sysv3 ;; sparc-* | *-sun) - os=-sunos4.1.1 + os=sunos4.1.1 ;; pru-*) - os=-elf + os=elf ;; *-be) - os=-beos + os=beos ;; *-ibm) - os=-aix + os=aix ;; *-knuth) - os=-mmixware + os=mmixware ;; *-wec) - os=-proelf + os=proelf ;; *-winbond) - os=-proelf + os=proelf ;; *-oki) - os=-proelf + os=proelf ;; *-hp) - os=-hpux + os=hpux ;; *-hitachi) - os=-hiux + os=hiux ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) - os=-sysv + os=sysv ;; *-cbm) - os=-amigaos + os=amigaos ;; *-dg) - os=-dgux + os=dgux ;; *-dolphin) - os=-sysv3 + os=sysv3 ;; m68k-ccur) - os=-rtu + os=rtu ;; m88k-omron*) - os=-luna + os=luna ;; *-next) - os=-nextstep + os=nextstep ;; *-sequent) - os=-ptx + os=ptx ;; *-crds) - os=-unos + os=unos ;; *-ns) - os=-genix + os=genix ;; i370-*) - os=-mvs + os=mvs ;; *-gould) - os=-sysv + os=sysv ;; *-highlevel) - os=-bsd + os=bsd ;; *-encore) - os=-bsd + os=bsd ;; *-sgi) - os=-irix + os=irix ;; *-siemens) - os=-sysv4 + os=sysv4 ;; *-masscomp) - os=-rtu + os=rtu ;; f30[01]-fujitsu | f700-fujitsu) - os=-uxpv + os=uxpv ;; *-rom68k) - os=-coff + os=coff ;; *-*bug) - os=-coff + os=coff ;; *-apple) - os=-macos + os=macos ;; *-atari*) - os=-mint + os=mint + ;; + *-wrs) + os=vxworks ;; *) - os=-none + os=none ;; esac + fi +# Now, validate our (potentially fixed-up) OS. +case $os in + # Sometimes we do "kernel-libc", so those need to count as OSes. + musl* | newlib* | uclibc*) + ;; + # Likewise for "kernel-abi" + eabi* | gnueabi*) + ;; + # VxWorks passes extra cpu info in the 4th filed. + simlinux | simwindows | spe) + ;; + # Now accept the basic system types. + # The portable systems comes first. + # Each alternative MUST end in a * to match a version number. + gnu* | android* | bsd* | mach* | minix* | genix* | ultrix* | irix* \ + | *vms* | esix* | aix* | cnk* | sunos | sunos[34]* \ + | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \ + | sym* | plan9* | psp* | sim* | xray* | os68k* | v88r* \ + | hiux* | abug | nacl* | netware* | windows* \ + | os9* | macos* | osx* | ios* \ + | mpw* | magic* | mmixware* | mon960* | lnews* \ + | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \ + | aos* | aros* | cloudabi* | sortix* | twizzler* \ + | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \ + | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \ + | mirbsd* | netbsd* | dicos* | openedition* | ose* \ + | bitrig* | openbsd* | secbsd* | solidbsd* | libertybsd* | os108* \ + | ekkobsd* | freebsd* | riscix* | lynxos* | os400* \ + | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \ + | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \ + | udi* | lites* | ieee* | go32* | aux* | hcos* \ + | chorusrdb* | cegcc* | glidix* | serenity* \ + | cygwin* | msys* | pe* | moss* | proelf* | rtems* \ + | midipix* | mingw32* | mingw64* | mint* \ + | uxpv* | beos* | mpeix* | udk* | moxiebox* \ + | interix* | uwin* | mks* | rhapsody* | darwin* \ + | openstep* | oskit* | conix* | pw32* | nonstopux* \ + | storm-chaos* | tops10* | tenex* | tops20* | its* \ + | os2* | vos* | palmos* | uclinux* | nucleus* | morphos* \ + | scout* | superux* | sysv* | rtmk* | tpf* | windiss* \ + | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \ + | skyos* | haiku* | rdos* | toppers* | drops* | es* \ + | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \ + | midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \ + | nsk* | powerunix* | genode* | zvmoe* | qnx* | emx*) + ;; + # This one is extra strict with allowed versions + sco3.2v2 | sco3.2v[4-9]* | sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + ;; + none) + ;; + *) + echo Invalid configuration \`"$1"\': OS \`"$os"\' not recognized 1>&2 + exit 1 + ;; +esac + +# As a final step for OS-related things, validate the OS-kernel combination +# (given a valid OS), if there is a kernel. +case $kernel-$os in + linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* | linux-musl* | linux-uclibc* ) + ;; + uclinux-uclibc* ) + ;; + -dietlibc* | -newlib* | -musl* | -uclibc* ) + # These are just libc implementations, not actual OSes, and thus + # require a kernel. + echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2 + exit 1 + ;; + kfreebsd*-gnu* | kopensolaris*-gnu*) + ;; + vxworks-simlinux | vxworks-simwindows | vxworks-spe) + ;; + nto-qnx*) + ;; + os2-emx) + ;; + *-eabi* | *-gnueabi*) + ;; + -*) + # Blank kernel with real OS is always fine. + ;; + *-*) + echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2 + exit 1 + ;; +esac + # Here we handle the case where we know the os, and the CPU type, but not the # manufacturer. We pick the logical manufacturer. -vendor=unknown -case $basic_machine in - *-unknown) - case $os in - -riscix*) +case $vendor in + unknown) + case $cpu-$os in + *-riscix*) vendor=acorn ;; - -sunos*) + *-sunos*) vendor=sun ;; - -cnk*|-aix*) + *-cnk* | *-aix*) vendor=ibm ;; - -beos*) + *-beos*) vendor=be ;; - -hpux*) + *-hpux*) vendor=hp ;; - -mpeix*) + *-mpeix*) vendor=hp ;; - -hiux*) + *-hiux*) vendor=hitachi ;; - -unos*) + *-unos*) vendor=crds ;; - -dgux*) + *-dgux*) vendor=dg ;; - -luna*) + *-luna*) vendor=omron ;; - -genix*) + *-genix*) vendor=ns ;; - -mvs* | -opened*) + *-clix*) + vendor=intergraph + ;; + *-mvs* | *-opened*) + vendor=ibm + ;; + *-os400*) vendor=ibm ;; - -os400*) + s390-* | s390x-*) vendor=ibm ;; - -ptx*) + *-ptx*) vendor=sequent ;; - -tpf*) + *-tpf*) vendor=ibm ;; - -vxsim* | -vxworks* | -windiss*) + *-vxsim* | *-vxworks* | *-windiss*) vendor=wrs ;; - -aux*) + *-aux*) vendor=apple ;; - -hms*) + *-hms*) vendor=hitachi ;; - -mpw* | -macos*) + *-mpw* | *-macos*) vendor=apple ;; - -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*) vendor=atari ;; - -vos*) + *-vos*) vendor=stratus ;; esac - basic_machine=`echo "$basic_machine" | sed "s/unknown/$vendor/"` ;; esac -echo "$basic_machine$os" +echo "$cpu-$vendor-${kernel:+$kernel-}$os" exit # Local variables: diff -Nru jimtcl-0.79+dfsg0/autosetup/autosetup-find-tclsh jimtcl-0.81+dfsg0/autosetup/autosetup-find-tclsh --- jimtcl-0.79+dfsg0/autosetup/autosetup-find-tclsh 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/autosetup-find-tclsh 2021-11-27 23:06:54.000000000 +0000 @@ -1,17 +1,15 @@ #!/bin/sh # Looks for a suitable tclsh or jimsh in the PATH -# If not found, builds a bootstrap jimsh from source -# Prefer $autosetup_tclsh if is set in the environment -d=`dirname "$0"` -{ "$d/jimsh0" "$d/autosetup-test-tclsh"; } 2>/dev/null && exit 0 -PATH="$PATH:$d"; export PATH -for tclsh in $autosetup_tclsh jimsh tclsh tclsh8.5 tclsh8.6; do +# If not found, builds a bootstrap jimsh in current dir from source +# Prefer $autosetup_tclsh if is set in the environment (unless ./jimsh0 works) +d="`dirname "$0"`" +for tclsh in ./jimsh0 $autosetup_tclsh jimsh tclsh tclsh8.5 tclsh8.6 tclsh8.7; do { $tclsh "$d/autosetup-test-tclsh"; } 2>/dev/null && exit 0 done echo 1>&2 "No installed jimsh or tclsh, building local bootstrap jimsh0" for cc in ${CC_FOR_BUILD:-cc} gcc; do - { $cc -o "$d/jimsh0" "$d/jimsh0.c"; } 2>/dev/null || continue - "$d/jimsh0" "$d/autosetup-test-tclsh" && exit 0 + { $cc -o jimsh0 "$d/jimsh0.c"; } 2>/dev/null || continue + ./jimsh0 "$d/autosetup-test-tclsh" && exit 0 done echo 1>&2 "No working C compiler found. Tried ${CC_FOR_BUILD:-cc} and gcc." echo false diff -Nru jimtcl-0.79+dfsg0/autosetup/cc-db.tcl jimtcl-0.81+dfsg0/autosetup/cc-db.tcl --- jimtcl-0.79+dfsg0/autosetup/cc-db.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/cc-db.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -8,7 +8,7 @@ use cc -module-options {} +options {} # openbsd needs sys/types.h to detect some system headers cc-include-needs sys/socket.h sys/types.h diff -Nru jimtcl-0.79+dfsg0/autosetup/cc-lib.tcl jimtcl-0.81+dfsg0/autosetup/cc-lib.tcl --- jimtcl-0.79+dfsg0/autosetup/cc-lib.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/cc-lib.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -7,8 +7,6 @@ use cc -module-options {} - # @cc-check-lfs # # The equivalent of the 'AC_SYS_LARGEFILE' macro. diff -Nru jimtcl-0.79+dfsg0/autosetup/cc-shared.tcl jimtcl-0.81+dfsg0/autosetup/cc-shared.tcl --- jimtcl-0.79+dfsg0/autosetup/cc-shared.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/cc-shared.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -20,7 +20,7 @@ ## LD_LIBRARY_PATH Environment variable which specifies path to shared libraries ## STRIPLIBFLAGS Arguments to strip a dynamic library -module-options {} +options {} # Defaults: gcc on unix define SHOBJ_CFLAGS -fPIC diff -Nru jimtcl-0.79+dfsg0/autosetup/cc.tcl jimtcl-0.81+dfsg0/autosetup/cc.tcl --- jimtcl-0.79+dfsg0/autosetup/cc.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/cc.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -29,7 +29,7 @@ use system -module-options {} +options {} # Checks for the existence of the given function by linking # @@ -680,11 +680,11 @@ define CPP [get-env CPP "[get-define CC] -E"] # XXX: Could avoid looking for a C++ compiler until requested -# Note that if CXX isn't found, we just set it to "false". It might not be needed. +# If CXX isn't found, it is set to the empty string. if {[env-is-set CXX]} { define CXX [find-an-executable -required [get-env CXX ""]] } else { - define CXX [find-an-executable [get-define cross]c++ [get-define cross]g++ false] + define CXX [find-an-executable [get-define cross]c++ [get-define cross]g++] } # CXXFLAGS default to CFLAGS if not specified diff -Nru jimtcl-0.79+dfsg0/autosetup/jimsh0.c jimtcl-0.81+dfsg0/autosetup/jimsh0.c --- jimtcl-0.79+dfsg0/autosetup/jimsh0.c 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/jimsh0.c 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,22509 @@ +/* This is single source file, bootstrap version of Jim Tcl. See http://jim.tcl.tk/ */ +#define JIM_TCL_COMPAT +#define JIM_ANSIC +#define JIM_REGEXP +#define HAVE_NO_AUTOCONF +#define _JIMAUTOCONF_H +#define TCL_LIBRARY "." +#define jim_ext_bootstrap +#define jim_ext_aio +#define jim_ext_readdir +#define jim_ext_regexp +#define jim_ext_file +#define jim_ext_glob +#define jim_ext_exec +#define jim_ext_clock +#define jim_ext_array +#define jim_ext_stdlib +#define jim_ext_tclcompat +#if defined(_MSC_VER) +#define TCL_PLATFORM_OS "windows" +#define TCL_PLATFORM_PLATFORM "windows" +#define TCL_PLATFORM_PATH_SEPARATOR ";" +#define HAVE_MKDIR_ONE_ARG +#define HAVE_SYSTEM +#elif defined(__MINGW32__) +#define TCL_PLATFORM_OS "mingw" +#define TCL_PLATFORM_PLATFORM "windows" +#define TCL_PLATFORM_PATH_SEPARATOR ";" +#define HAVE_MKDIR_ONE_ARG +#define HAVE_SYSTEM +#define HAVE_SYS_TIME_H +#define HAVE_DIRENT_H +#define HAVE_UNISTD_H +#define HAVE_UMASK +#include +#ifndef S_IRWXG +#define S_IRWXG 0 +#endif +#ifndef S_IRWXO +#define S_IRWXO 0 +#endif +#else +#define TCL_PLATFORM_OS "unknown" +#define TCL_PLATFORM_PLATFORM "unix" +#define TCL_PLATFORM_PATH_SEPARATOR ":" +#ifdef _MINIX +#define vfork fork +#define _POSIX_SOURCE +#else +#define _GNU_SOURCE +#endif +#define HAVE_VFORK +#define HAVE_WAITPID +#define HAVE_ISATTY +#define HAVE_MKSTEMP +#define HAVE_LINK +#define HAVE_SYS_TIME_H +#define HAVE_DIRENT_H +#define HAVE_UNISTD_H +#define HAVE_UMASK +#endif +#define JIM_VERSION 78 +#ifndef JIM_WIN32COMPAT_H +#define JIM_WIN32COMPAT_H + + + +#ifdef __cplusplus +extern "C" { +#endif + + +#if defined(_WIN32) || defined(WIN32) + +#define HAVE_DLOPEN +void *dlopen(const char *path, int mode); +int dlclose(void *handle); +void *dlsym(void *handle, const char *symbol); +char *dlerror(void); + + +#if defined(__MINGW32__) + #define JIM_SPRINTF_DOUBLE_NEEDS_FIX +#endif + +#ifdef _MSC_VER + + +#if _MSC_VER >= 1000 + #pragma warning(disable:4146) +#endif + +#include +#define jim_wide _int64 +#ifndef LLONG_MAX + #define LLONG_MAX 9223372036854775807I64 +#endif +#ifndef LLONG_MIN + #define LLONG_MIN (-LLONG_MAX - 1I64) +#endif +#define JIM_WIDE_MIN LLONG_MIN +#define JIM_WIDE_MAX LLONG_MAX +#define JIM_WIDE_MODIFIER "I64d" +#define strcasecmp _stricmp +#define strtoull _strtoui64 + +#include + +struct timeval { + long tv_sec; + long tv_usec; +}; + +int gettimeofday(struct timeval *tv, void *unused); + +#define HAVE_OPENDIR +struct dirent { + char *d_name; +}; + +typedef struct DIR { + long handle; + struct _finddata_t info; + struct dirent result; + char *name; +} DIR; + +DIR *opendir(const char *name); +int closedir(DIR *dir); +struct dirent *readdir(DIR *dir); + +#endif + +#endif + +#ifdef __cplusplus +} +#endif + +#endif +#ifndef UTF8_UTIL_H +#define UTF8_UTIL_H + +#ifdef __cplusplus +extern "C" { +#endif + + + +#define MAX_UTF8_LEN 4 + +int utf8_fromunicode(char *p, unsigned uc); + +#ifndef JIM_UTF8 +#include + + +#define utf8_strlen(S, B) ((B) < 0 ? (int)strlen(S) : (B)) +#define utf8_strwidth(S, B) utf8_strlen((S), (B)) +#define utf8_tounicode(S, CP) (*(CP) = (unsigned char)*(S), 1) +#define utf8_getchars(CP, C) (*(CP) = (C), 1) +#define utf8_upper(C) toupper(C) +#define utf8_title(C) toupper(C) +#define utf8_lower(C) tolower(C) +#define utf8_index(C, I) (I) +#define utf8_charlen(C) 1 +#define utf8_prev_len(S, L) 1 +#define utf8_width(C) 1 + +#else + +#endif + +#ifdef __cplusplus +} +#endif + +#endif + +#ifndef __JIM__H +#define __JIM__H + +#ifdef __cplusplus +extern "C" { +#endif + +#include +#include +#include +#include +#include + + +#ifndef HAVE_NO_AUTOCONF +#endif + + + +#ifndef jim_wide +# ifdef HAVE_LONG_LONG +# define jim_wide long long +# ifndef LLONG_MAX +# define LLONG_MAX 9223372036854775807LL +# endif +# ifndef LLONG_MIN +# define LLONG_MIN (-LLONG_MAX - 1LL) +# endif +# define JIM_WIDE_MIN LLONG_MIN +# define JIM_WIDE_MAX LLONG_MAX +# else +# define jim_wide long +# define JIM_WIDE_MIN LONG_MIN +# define JIM_WIDE_MAX LONG_MAX +# endif + + +# ifdef HAVE_LONG_LONG +# define JIM_WIDE_MODIFIER "lld" +# else +# define JIM_WIDE_MODIFIER "ld" +# define strtoull strtoul +# endif +#endif + +#define UCHAR(c) ((unsigned char)(c)) + + +#define JIM_OK 0 +#define JIM_ERR 1 +#define JIM_RETURN 2 +#define JIM_BREAK 3 +#define JIM_CONTINUE 4 +#define JIM_SIGNAL 5 +#define JIM_EXIT 6 + +#define JIM_EVAL 7 + +#define JIM_MAX_CALLFRAME_DEPTH 1000 +#define JIM_MAX_EVAL_DEPTH 2000 + + +#define JIM_PRIV_FLAG_SHIFT 20 + +#define JIM_NONE 0 +#define JIM_ERRMSG 1 +#define JIM_ENUM_ABBREV 2 +#define JIM_UNSHARED 4 +#define JIM_MUSTEXIST 8 + + +#define JIM_SUBST_NOVAR 1 +#define JIM_SUBST_NOCMD 2 +#define JIM_SUBST_NOESC 4 +#define JIM_SUBST_FLAG 128 + + +#define JIM_CASESENS 0 +#define JIM_NOCASE 1 + + +#define JIM_PATH_LEN 1024 + + +#define JIM_NOTUSED(V) ((void) V) + +#define JIM_LIBPATH "auto_path" +#define JIM_INTERACTIVE "tcl_interactive" + + +typedef struct Jim_Stack { + int len; + int maxlen; + void **vector; +} Jim_Stack; + + +typedef struct Jim_HashEntry { + void *key; + union { + void *val; + int intval; + } u; + struct Jim_HashEntry *next; +} Jim_HashEntry; + +typedef struct Jim_HashTableType { + unsigned int (*hashFunction)(const void *key); + void *(*keyDup)(void *privdata, const void *key); + void *(*valDup)(void *privdata, const void *obj); + int (*keyCompare)(void *privdata, const void *key1, const void *key2); + void (*keyDestructor)(void *privdata, void *key); + void (*valDestructor)(void *privdata, void *obj); +} Jim_HashTableType; + +typedef struct Jim_HashTable { + Jim_HashEntry **table; + const Jim_HashTableType *type; + void *privdata; + unsigned int size; + unsigned int sizemask; + unsigned int used; + unsigned int collisions; + unsigned int uniq; +} Jim_HashTable; + +typedef struct Jim_HashTableIterator { + Jim_HashTable *ht; + Jim_HashEntry *entry, *nextEntry; + int index; +} Jim_HashTableIterator; + + +#define JIM_HT_INITIAL_SIZE 16 + + +#define Jim_FreeEntryVal(ht, entry) \ + if ((ht)->type->valDestructor) \ + (ht)->type->valDestructor((ht)->privdata, (entry)->u.val) + +#define Jim_SetHashVal(ht, entry, _val_) do { \ + if ((ht)->type->valDup) \ + (entry)->u.val = (ht)->type->valDup((ht)->privdata, (_val_)); \ + else \ + (entry)->u.val = (_val_); \ +} while(0) + +#define Jim_FreeEntryKey(ht, entry) \ + if ((ht)->type->keyDestructor) \ + (ht)->type->keyDestructor((ht)->privdata, (entry)->key) + +#define Jim_SetHashKey(ht, entry, _key_) do { \ + if ((ht)->type->keyDup) \ + (entry)->key = (ht)->type->keyDup((ht)->privdata, (_key_)); \ + else \ + (entry)->key = (void *)(_key_); \ +} while(0) + +#define Jim_CompareHashKeys(ht, key1, key2) \ + (((ht)->type->keyCompare) ? \ + (ht)->type->keyCompare((ht)->privdata, (key1), (key2)) : \ + (key1) == (key2)) + +#define Jim_HashKey(ht, key) ((ht)->type->hashFunction(key) + (ht)->uniq) + +#define Jim_GetHashEntryKey(he) ((he)->key) +#define Jim_GetHashEntryVal(he) ((he)->u.val) +#define Jim_GetHashTableCollisions(ht) ((ht)->collisions) +#define Jim_GetHashTableSize(ht) ((ht)->size) +#define Jim_GetHashTableUsed(ht) ((ht)->used) + + +typedef struct Jim_Obj { + char *bytes; + const struct Jim_ObjType *typePtr; + int refCount; + int length; + + union { + + jim_wide wideValue; + + int intValue; + + double doubleValue; + + void *ptr; + + struct { + void *ptr1; + void *ptr2; + } twoPtrValue; + + struct { + void *ptr; + int int1; + int int2; + } ptrIntValue; + + struct { + struct Jim_Var *varPtr; + unsigned long callFrameId; + int global; + } varValue; + + struct { + struct Jim_Obj *nsObj; + struct Jim_Cmd *cmdPtr; + unsigned long procEpoch; + } cmdValue; + + struct { + struct Jim_Obj **ele; + int len; + int maxLen; + } listValue; + + struct { + int maxLength; + int charLength; + } strValue; + + struct { + unsigned long id; + struct Jim_Reference *refPtr; + } refValue; + + struct { + struct Jim_Obj *fileNameObj; + int lineNumber; + } sourceValue; + + struct { + struct Jim_Obj *varNameObjPtr; + struct Jim_Obj *indexObjPtr; + } dictSubstValue; + struct { + int line; + int argc; + } scriptLineValue; + } internalRep; + struct Jim_Obj *prevObjPtr; + struct Jim_Obj *nextObjPtr; +} Jim_Obj; + + +#define Jim_IncrRefCount(objPtr) \ + ++(objPtr)->refCount +#define Jim_DecrRefCount(interp, objPtr) \ + if (--(objPtr)->refCount <= 0) Jim_FreeObj(interp, objPtr) +#define Jim_IsShared(objPtr) \ + ((objPtr)->refCount > 1) + +#define Jim_FreeNewObj Jim_FreeObj + + +#define Jim_FreeIntRep(i,o) \ + if ((o)->typePtr && (o)->typePtr->freeIntRepProc) \ + (o)->typePtr->freeIntRepProc(i, o) + + +#define Jim_GetIntRepPtr(o) (o)->internalRep.ptr + + +#define Jim_SetIntRepPtr(o, p) \ + (o)->internalRep.ptr = (p) + + +struct Jim_Interp; + +typedef void (Jim_FreeInternalRepProc)(struct Jim_Interp *interp, + struct Jim_Obj *objPtr); +typedef void (Jim_DupInternalRepProc)(struct Jim_Interp *interp, + struct Jim_Obj *srcPtr, Jim_Obj *dupPtr); +typedef void (Jim_UpdateStringProc)(struct Jim_Obj *objPtr); + +typedef struct Jim_ObjType { + const char *name; + Jim_FreeInternalRepProc *freeIntRepProc; + Jim_DupInternalRepProc *dupIntRepProc; + Jim_UpdateStringProc *updateStringProc; + int flags; +} Jim_ObjType; + + +#define JIM_TYPE_NONE 0 +#define JIM_TYPE_REFERENCES 1 + + + +typedef struct Jim_CallFrame { + unsigned long id; + int level; + struct Jim_HashTable vars; + struct Jim_HashTable *staticVars; + struct Jim_CallFrame *parent; + Jim_Obj *const *argv; + int argc; + Jim_Obj *procArgsObjPtr; + Jim_Obj *procBodyObjPtr; + struct Jim_CallFrame *next; + Jim_Obj *nsObj; + Jim_Obj *fileNameObj; + int line; + Jim_Stack *localCommands; + struct Jim_Obj *tailcallObj; + struct Jim_Cmd *tailcallCmd; +} Jim_CallFrame; + +typedef struct Jim_Var { + Jim_Obj *objPtr; + struct Jim_CallFrame *linkFramePtr; +} Jim_Var; + + +typedef int Jim_CmdProc(struct Jim_Interp *interp, int argc, + Jim_Obj *const *argv); +typedef void Jim_DelCmdProc(struct Jim_Interp *interp, void *privData); + + + +typedef struct Jim_Cmd { + int inUse; + int isproc; + struct Jim_Cmd *prevCmd; + union { + struct { + + Jim_CmdProc *cmdProc; + Jim_DelCmdProc *delProc; + void *privData; + } native; + struct { + + Jim_Obj *argListObjPtr; + Jim_Obj *bodyObjPtr; + Jim_HashTable *staticVars; + int argListLen; + int reqArity; + int optArity; + int argsPos; + int upcall; + struct Jim_ProcArg { + Jim_Obj *nameObjPtr; + Jim_Obj *defaultObjPtr; + } *arglist; + Jim_Obj *nsObj; + } proc; + } u; +} Jim_Cmd; + + +typedef struct Jim_PrngState { + unsigned char sbox[256]; + unsigned int i, j; +} Jim_PrngState; + +typedef struct Jim_Interp { + Jim_Obj *result; + int errorLine; + Jim_Obj *errorFileNameObj; + int addStackTrace; + int maxCallFrameDepth; + int maxEvalDepth; + int evalDepth; + int returnCode; + int returnLevel; + int exitCode; + long id; + int signal_level; + jim_wide sigmask; + int (*signal_set_result)(struct Jim_Interp *interp, jim_wide sigmask); + Jim_CallFrame *framePtr; + Jim_CallFrame *topFramePtr; + struct Jim_HashTable commands; + unsigned long procEpoch; /* Incremented every time the result + of procedures names lookup caching + may no longer be valid. */ + unsigned long callFrameEpoch; /* Incremented every time a new + callframe is created. This id is used for the + 'ID' field contained in the Jim_CallFrame + structure. */ + int local; + Jim_Obj *liveList; + Jim_Obj *freeList; + Jim_Obj *currentScriptObj; + Jim_Obj *nullScriptObj; + Jim_Obj *emptyObj; + Jim_Obj *trueObj; + Jim_Obj *falseObj; + unsigned long referenceNextId; + struct Jim_HashTable references; + unsigned long lastCollectId; /* reference max Id of the last GC + execution. It's set to ~0 while the collection + is running as sentinel to avoid to recursive + calls via the [collect] command inside + finalizers. */ + time_t lastCollectTime; + Jim_Obj *stackTrace; + Jim_Obj *errorProc; + Jim_Obj *unknown; + int unknown_called; + int errorFlag; + void *cmdPrivData; /* Used to pass the private data pointer to + a command. It is set to what the user specified + via Jim_CreateCommand(). */ + + struct Jim_CallFrame *freeFramesList; + struct Jim_HashTable assocData; + Jim_PrngState *prngState; + struct Jim_HashTable packages; + Jim_Stack *loadHandles; +} Jim_Interp; + +#define Jim_InterpIncrProcEpoch(i) (i)->procEpoch++ +#define Jim_SetResultString(i,s,l) Jim_SetResult(i, Jim_NewStringObj(i,s,l)) +#define Jim_SetResultInt(i,intval) Jim_SetResult(i, Jim_NewIntObj(i,intval)) + +#define Jim_SetResultBool(i,b) Jim_SetResultInt(i, b) +#define Jim_SetEmptyResult(i) Jim_SetResult(i, (i)->emptyObj) +#define Jim_GetResult(i) ((i)->result) +#define Jim_CmdPrivData(i) ((i)->cmdPrivData) + +#define Jim_SetResult(i,o) do { \ + Jim_Obj *_resultObjPtr_ = (o); \ + Jim_IncrRefCount(_resultObjPtr_); \ + Jim_DecrRefCount(i,(i)->result); \ + (i)->result = _resultObjPtr_; \ +} while(0) + + +#define Jim_GetId(i) (++(i)->id) + + +#define JIM_REFERENCE_TAGLEN 7 /* The tag is fixed-length, because the reference + string representation must be fixed length. */ +typedef struct Jim_Reference { + Jim_Obj *objPtr; + Jim_Obj *finalizerCmdNamePtr; + char tag[JIM_REFERENCE_TAGLEN+1]; +} Jim_Reference; + + +#define Jim_NewEmptyStringObj(i) Jim_NewStringObj(i, "", 0) +#define Jim_FreeHashTableIterator(iter) Jim_Free(iter) + +#define JIM_EXPORT + + +JIM_EXPORT void *Jim_Alloc (int size); +JIM_EXPORT void *Jim_Realloc(void *ptr, int size); +JIM_EXPORT void Jim_Free (void *ptr); +JIM_EXPORT char * Jim_StrDup (const char *s); +JIM_EXPORT char *Jim_StrDupLen(const char *s, int l); + + +JIM_EXPORT char **Jim_GetEnviron(void); +JIM_EXPORT void Jim_SetEnviron(char **env); +JIM_EXPORT int Jim_MakeTempFile(Jim_Interp *interp, const char *filename_template, int unlink_file); + + +JIM_EXPORT int Jim_Eval(Jim_Interp *interp, const char *script); + + +JIM_EXPORT int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script); + +#define Jim_Eval_Named(I, S, F, L) Jim_EvalSource((I), (F), (L), (S)) + +JIM_EXPORT int Jim_EvalGlobal(Jim_Interp *interp, const char *script); +JIM_EXPORT int Jim_EvalFile(Jim_Interp *interp, const char *filename); +JIM_EXPORT int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename); +JIM_EXPORT int Jim_EvalObj (Jim_Interp *interp, Jim_Obj *scriptObjPtr); +JIM_EXPORT int Jim_EvalObjVector (Jim_Interp *interp, int objc, + Jim_Obj *const *objv); +JIM_EXPORT int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listObj); +JIM_EXPORT int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, + int objc, Jim_Obj *const *objv); +#define Jim_EvalPrefix(i, p, oc, ov) Jim_EvalObjPrefix((i), Jim_NewStringObj((i), (p), -1), (oc), (ov)) +JIM_EXPORT int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj); +JIM_EXPORT int Jim_SubstObj (Jim_Interp *interp, Jim_Obj *substObjPtr, + Jim_Obj **resObjPtrPtr, int flags); + + +JIM_EXPORT void Jim_InitStack(Jim_Stack *stack); +JIM_EXPORT void Jim_FreeStack(Jim_Stack *stack); +JIM_EXPORT int Jim_StackLen(Jim_Stack *stack); +JIM_EXPORT void Jim_StackPush(Jim_Stack *stack, void *element); +JIM_EXPORT void * Jim_StackPop(Jim_Stack *stack); +JIM_EXPORT void * Jim_StackPeek(Jim_Stack *stack); +JIM_EXPORT void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr)); + + +JIM_EXPORT int Jim_InitHashTable (Jim_HashTable *ht, + const Jim_HashTableType *type, void *privdata); +JIM_EXPORT void Jim_ExpandHashTable (Jim_HashTable *ht, + unsigned int size); +JIM_EXPORT int Jim_AddHashEntry (Jim_HashTable *ht, const void *key, + void *val); +JIM_EXPORT int Jim_ReplaceHashEntry (Jim_HashTable *ht, + const void *key, void *val); +JIM_EXPORT int Jim_DeleteHashEntry (Jim_HashTable *ht, + const void *key); +JIM_EXPORT int Jim_FreeHashTable (Jim_HashTable *ht); +JIM_EXPORT Jim_HashEntry * Jim_FindHashEntry (Jim_HashTable *ht, + const void *key); +JIM_EXPORT void Jim_ResizeHashTable (Jim_HashTable *ht); +JIM_EXPORT Jim_HashTableIterator *Jim_GetHashTableIterator + (Jim_HashTable *ht); +JIM_EXPORT Jim_HashEntry * Jim_NextHashEntry + (Jim_HashTableIterator *iter); + + +JIM_EXPORT Jim_Obj * Jim_NewObj (Jim_Interp *interp); +JIM_EXPORT void Jim_FreeObj (Jim_Interp *interp, Jim_Obj *objPtr); +JIM_EXPORT void Jim_InvalidateStringRep (Jim_Obj *objPtr); +JIM_EXPORT Jim_Obj * Jim_DuplicateObj (Jim_Interp *interp, + Jim_Obj *objPtr); +JIM_EXPORT const char * Jim_GetString(Jim_Obj *objPtr, + int *lenPtr); +JIM_EXPORT const char *Jim_String(Jim_Obj *objPtr); +JIM_EXPORT int Jim_Length(Jim_Obj *objPtr); + + +JIM_EXPORT Jim_Obj * Jim_NewStringObj (Jim_Interp *interp, + const char *s, int len); +JIM_EXPORT Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, + const char *s, int charlen); +JIM_EXPORT Jim_Obj * Jim_NewStringObjNoAlloc (Jim_Interp *interp, + char *s, int len); +JIM_EXPORT void Jim_AppendString (Jim_Interp *interp, Jim_Obj *objPtr, + const char *str, int len); +JIM_EXPORT void Jim_AppendObj (Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *appendObjPtr); +JIM_EXPORT void Jim_AppendStrings (Jim_Interp *interp, + Jim_Obj *objPtr, ...); +JIM_EXPORT int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr); +JIM_EXPORT int Jim_StringMatchObj (Jim_Interp *interp, Jim_Obj *patternObjPtr, + Jim_Obj *objPtr, int nocase); +JIM_EXPORT Jim_Obj * Jim_StringRangeObj (Jim_Interp *interp, + Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, + Jim_Obj *lastObjPtr); +JIM_EXPORT Jim_Obj * Jim_FormatString (Jim_Interp *interp, + Jim_Obj *fmtObjPtr, int objc, Jim_Obj *const *objv); +JIM_EXPORT Jim_Obj * Jim_ScanString (Jim_Interp *interp, Jim_Obj *strObjPtr, + Jim_Obj *fmtObjPtr, int flags); +JIM_EXPORT int Jim_CompareStringImmediate (Jim_Interp *interp, + Jim_Obj *objPtr, const char *str); +JIM_EXPORT int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, + Jim_Obj *secondObjPtr, int nocase); +JIM_EXPORT int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, + Jim_Obj *secondObjPtr, int nocase); +JIM_EXPORT int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr); + + +JIM_EXPORT Jim_Obj * Jim_NewReference (Jim_Interp *interp, + Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr); +JIM_EXPORT Jim_Reference * Jim_GetReference (Jim_Interp *interp, + Jim_Obj *objPtr); +JIM_EXPORT int Jim_SetFinalizer (Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr); +JIM_EXPORT int Jim_GetFinalizer (Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr); + + +JIM_EXPORT Jim_Interp * Jim_CreateInterp (void); +JIM_EXPORT void Jim_FreeInterp (Jim_Interp *i); +JIM_EXPORT int Jim_GetExitCode (Jim_Interp *interp); +JIM_EXPORT const char *Jim_ReturnCode(int code); +JIM_EXPORT void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...); + + +JIM_EXPORT void Jim_RegisterCoreCommands (Jim_Interp *interp); +JIM_EXPORT int Jim_CreateCommand (Jim_Interp *interp, + const char *cmdName, Jim_CmdProc *cmdProc, void *privData, + Jim_DelCmdProc *delProc); +JIM_EXPORT int Jim_DeleteCommand (Jim_Interp *interp, + const char *cmdName); +JIM_EXPORT int Jim_RenameCommand (Jim_Interp *interp, + const char *oldName, const char *newName); +JIM_EXPORT Jim_Cmd * Jim_GetCommand (Jim_Interp *interp, + Jim_Obj *objPtr, int flags); +JIM_EXPORT int Jim_SetVariable (Jim_Interp *interp, + Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr); +JIM_EXPORT int Jim_SetVariableStr (Jim_Interp *interp, + const char *name, Jim_Obj *objPtr); +JIM_EXPORT int Jim_SetGlobalVariableStr (Jim_Interp *interp, + const char *name, Jim_Obj *objPtr); +JIM_EXPORT int Jim_SetVariableStrWithStr (Jim_Interp *interp, + const char *name, const char *val); +JIM_EXPORT int Jim_SetVariableLink (Jim_Interp *interp, + Jim_Obj *nameObjPtr, Jim_Obj *targetNameObjPtr, + Jim_CallFrame *targetCallFrame); +JIM_EXPORT Jim_Obj * Jim_MakeGlobalNamespaceName(Jim_Interp *interp, + Jim_Obj *nameObjPtr); +JIM_EXPORT Jim_Obj * Jim_GetVariable (Jim_Interp *interp, + Jim_Obj *nameObjPtr, int flags); +JIM_EXPORT Jim_Obj * Jim_GetGlobalVariable (Jim_Interp *interp, + Jim_Obj *nameObjPtr, int flags); +JIM_EXPORT Jim_Obj * Jim_GetVariableStr (Jim_Interp *interp, + const char *name, int flags); +JIM_EXPORT Jim_Obj * Jim_GetGlobalVariableStr (Jim_Interp *interp, + const char *name, int flags); +JIM_EXPORT int Jim_UnsetVariable (Jim_Interp *interp, + Jim_Obj *nameObjPtr, int flags); + + +JIM_EXPORT Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, + Jim_Obj *levelObjPtr); + + +JIM_EXPORT int Jim_Collect (Jim_Interp *interp); +JIM_EXPORT void Jim_CollectIfNeeded (Jim_Interp *interp); + + +JIM_EXPORT int Jim_GetIndex (Jim_Interp *interp, Jim_Obj *objPtr, + int *indexPtr); + + +JIM_EXPORT Jim_Obj * Jim_NewListObj (Jim_Interp *interp, + Jim_Obj *const *elements, int len); +JIM_EXPORT void Jim_ListInsertElements (Jim_Interp *interp, + Jim_Obj *listPtr, int listindex, int objc, Jim_Obj *const *objVec); +JIM_EXPORT void Jim_ListAppendElement (Jim_Interp *interp, + Jim_Obj *listPtr, Jim_Obj *objPtr); +JIM_EXPORT void Jim_ListAppendList (Jim_Interp *interp, + Jim_Obj *listPtr, Jim_Obj *appendListPtr); +JIM_EXPORT int Jim_ListLength (Jim_Interp *interp, Jim_Obj *objPtr); +JIM_EXPORT int Jim_ListIndex (Jim_Interp *interp, Jim_Obj *listPrt, + int listindex, Jim_Obj **objPtrPtr, int seterr); +JIM_EXPORT Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx); +JIM_EXPORT int Jim_SetListIndex (Jim_Interp *interp, + Jim_Obj *varNamePtr, Jim_Obj *const *indexv, int indexc, + Jim_Obj *newObjPtr); +JIM_EXPORT Jim_Obj * Jim_ConcatObj (Jim_Interp *interp, int objc, + Jim_Obj *const *objv); +JIM_EXPORT Jim_Obj *Jim_ListJoin(Jim_Interp *interp, + Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen); + + +JIM_EXPORT Jim_Obj * Jim_NewDictObj (Jim_Interp *interp, + Jim_Obj *const *elements, int len); +JIM_EXPORT int Jim_DictKey (Jim_Interp *interp, Jim_Obj *dictPtr, + Jim_Obj *keyPtr, Jim_Obj **objPtrPtr, int flags); +JIM_EXPORT int Jim_DictKeysVector (Jim_Interp *interp, + Jim_Obj *dictPtr, Jim_Obj *const *keyv, int keyc, + Jim_Obj **objPtrPtr, int flags); +JIM_EXPORT int Jim_SetDictKeysVector (Jim_Interp *interp, + Jim_Obj *varNamePtr, Jim_Obj *const *keyv, int keyc, + Jim_Obj *newObjPtr, int flags); +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); + +#define JIM_DICTMATCH_KEYS 0x0001 +#define JIM_DICTMATCH_VALUES 0x002 + +JIM_EXPORT int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types); +JIM_EXPORT int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr); +JIM_EXPORT int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr); +JIM_EXPORT Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv); + + +JIM_EXPORT int Jim_GetReturnCode (Jim_Interp *interp, Jim_Obj *objPtr, + int *intPtr); + + +JIM_EXPORT int Jim_EvalExpression (Jim_Interp *interp, + Jim_Obj *exprObjPtr); +JIM_EXPORT int Jim_GetBoolFromExpr (Jim_Interp *interp, + Jim_Obj *exprObjPtr, int *boolPtr); + + +JIM_EXPORT int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, + int *booleanPtr); + + +JIM_EXPORT int Jim_GetWide (Jim_Interp *interp, Jim_Obj *objPtr, + jim_wide *widePtr); +JIM_EXPORT int Jim_GetLong (Jim_Interp *interp, Jim_Obj *objPtr, + long *longPtr); +#define Jim_NewWideObj Jim_NewIntObj +JIM_EXPORT Jim_Obj * Jim_NewIntObj (Jim_Interp *interp, + jim_wide wideValue); + + +JIM_EXPORT int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, + double *doublePtr); +JIM_EXPORT void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, + double doubleValue); +JIM_EXPORT Jim_Obj * Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue); + + +JIM_EXPORT void Jim_WrongNumArgs (Jim_Interp *interp, int argc, + Jim_Obj *const *argv, const char *msg); +JIM_EXPORT int Jim_GetEnum (Jim_Interp *interp, Jim_Obj *objPtr, + const char * const *tablePtr, int *indexPtr, const char *name, int flags); +JIM_EXPORT int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, + const char *const *tablePtr); +JIM_EXPORT int Jim_ScriptIsComplete(Jim_Interp *interp, + Jim_Obj *scriptObj, char *stateCharPtr); + +JIM_EXPORT int Jim_FindByName(const char *name, const char * const array[], size_t len); + + +typedef void (Jim_InterpDeleteProc)(Jim_Interp *interp, void *data); +JIM_EXPORT void * Jim_GetAssocData(Jim_Interp *interp, const char *key); +JIM_EXPORT int Jim_SetAssocData(Jim_Interp *interp, const char *key, + Jim_InterpDeleteProc *delProc, void *data); +JIM_EXPORT int Jim_DeleteAssocData(Jim_Interp *interp, const char *key); + + + +JIM_EXPORT int Jim_PackageProvide (Jim_Interp *interp, + const char *name, const char *ver, int flags); +JIM_EXPORT int Jim_PackageRequire (Jim_Interp *interp, + const char *name, int flags); + + +JIM_EXPORT void Jim_MakeErrorMessage (Jim_Interp *interp); + + +JIM_EXPORT int Jim_InteractivePrompt (Jim_Interp *interp); +JIM_EXPORT void Jim_HistoryLoad(const char *filename); +JIM_EXPORT void Jim_HistorySave(const char *filename); +JIM_EXPORT char *Jim_HistoryGetline(Jim_Interp *interp, const char *prompt); +JIM_EXPORT void Jim_HistorySetCompletion(Jim_Interp *interp, Jim_Obj *commandObj); +JIM_EXPORT void Jim_HistoryAdd(const char *line); +JIM_EXPORT void Jim_HistoryShow(void); + + +JIM_EXPORT int Jim_InitStaticExtensions(Jim_Interp *interp); +JIM_EXPORT int Jim_StringToWide(const char *str, jim_wide *widePtr, int base); +JIM_EXPORT int Jim_IsBigEndian(void); + +#define Jim_CheckSignal(i) ((i)->signal_level && (i)->sigmask) + + +JIM_EXPORT int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName); +JIM_EXPORT void Jim_FreeLoadHandles(Jim_Interp *interp); + + +JIM_EXPORT FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *command); + + +JIM_EXPORT int Jim_IsDict(Jim_Obj *objPtr); +JIM_EXPORT int Jim_IsList(Jim_Obj *objPtr); + +#ifdef __cplusplus +} +#endif + +#endif + +#ifndef JIM_SUBCMD_H +#define JIM_SUBCMD_H + + +#ifdef __cplusplus +extern "C" { +#endif + + +#define JIM_MODFLAG_HIDDEN 0x0001 +#define JIM_MODFLAG_FULLARGV 0x0002 + + + +typedef int jim_subcmd_function(Jim_Interp *interp, int argc, Jim_Obj *const *argv); + +typedef struct { + const char *cmd; + const char *args; + jim_subcmd_function *function; + short minargs; + short maxargs; + unsigned short flags; +} jim_subcmd_type; + +const jim_subcmd_type * +Jim_ParseSubCmd(Jim_Interp *interp, const jim_subcmd_type *command_table, int argc, Jim_Obj *const *argv); + +int Jim_SubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv); + +int Jim_CallSubCmd(Jim_Interp *interp, const jim_subcmd_type *ct, int argc, Jim_Obj *const *argv); + +#ifdef __cplusplus +} +#endif + +#endif +#ifndef JIMREGEXP_H +#define JIMREGEXP_H + + +#ifdef __cplusplus +extern "C" { +#endif + +#include + +typedef struct { + int rm_so; + int rm_eo; +} regmatch_t; + + +typedef struct regexp { + + int re_nsub; + + + int cflags; + int err; + int regstart; + int reganch; + int regmust; + int regmlen; + int *program; + + + const char *regparse; + int p; + int proglen; + + + int eflags; + const char *start; + const char *reginput; + const char *regbol; + + + regmatch_t *pmatch; + int nmatch; +} regexp; + +typedef regexp regex_t; + +#define REG_EXTENDED 0 +#define REG_NEWLINE 1 +#define REG_ICASE 2 + +#define REG_NOTBOL 16 + +enum { + REG_NOERROR, + REG_NOMATCH, + REG_BADPAT, + REG_ERR_NULL_ARGUMENT, + REG_ERR_UNKNOWN, + REG_ERR_TOO_BIG, + REG_ERR_NOMEM, + REG_ERR_TOO_MANY_PAREN, + REG_ERR_UNMATCHED_PAREN, + REG_ERR_UNMATCHED_BRACES, + REG_ERR_BAD_COUNT, + REG_ERR_JUNK_ON_END, + REG_ERR_OPERAND_COULD_BE_EMPTY, + REG_ERR_NESTED_COUNT, + REG_ERR_INTERNAL, + REG_ERR_COUNT_FOLLOWS_NOTHING, + REG_ERR_TRAILING_BACKSLASH, + REG_ERR_CORRUPTED, + REG_ERR_NULL_CHAR, + REG_ERR_NUM +}; + +int regcomp(regex_t *preg, const char *regex, int cflags); +int regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags); +size_t regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size); +void regfree(regex_t *preg); + +#ifdef __cplusplus +} +#endif + +#endif +#ifndef JIM_SIGNAL_H +#define JIM_SIGNAL_H + +#ifdef __cplusplus +extern "C" { +#endif + +const char *Jim_SignalId(int sig); + +#ifdef __cplusplus +} +#endif + +#endif +#ifndef JIMIOCOMPAT_H +#define JIMIOCOMPAT_H + + +#include +#include + + +void Jim_SetResultErrno(Jim_Interp *interp, const char *msg); + +int Jim_OpenForWrite(const char *filename, int append); + +int Jim_OpenForRead(const char *filename); + +#if defined(__MINGW32__) + #ifndef STRICT + #define STRICT + #endif + #define WIN32_LEAN_AND_MEAN + #include + #include + #include + #include + + typedef HANDLE pidtype; + #define JIM_BAD_PID INVALID_HANDLE_VALUE + + #define JIM_NO_PID INVALID_HANDLE_VALUE + + + #define WIFEXITED(STATUS) (((STATUS) & 0xff00) == 0) + #define WEXITSTATUS(STATUS) ((STATUS) & 0x00ff) + #define WIFSIGNALED(STATUS) (((STATUS) & 0xff00) != 0) + #define WTERMSIG(STATUS) (((STATUS) >> 8) & 0xff) + #define WNOHANG 1 + + int Jim_Errno(void); + pidtype waitpid(pidtype pid, int *status, int nohang); + + #define HAVE_PIPE + #define pipe(P) _pipe((P), 0, O_NOINHERIT) + +#elif defined(HAVE_UNISTD_H) + #include + #include + #include + #include + + typedef int pidtype; + #define Jim_Errno() errno + #define JIM_BAD_PID -1 + #define JIM_NO_PID 0 + + #ifndef HAVE_EXECVPE + #define execvpe(ARG0, ARGV, ENV) execvp(ARG0, ARGV) + #endif +#endif + +#endif +int Jim_bootstrapInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "bootstrap", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "bootstrap.tcl", 1, +"\n" +"\n" +"proc package {cmd pkg args} {\n" +" if {$cmd eq \"require\"} {\n" +" foreach path $::auto_path {\n" +" set pkgpath $path/$pkg.tcl\n" +" if {$path eq \".\"} {\n" +" set pkgpath $pkg.tcl\n" +" }\n" +" if {[file exists $pkgpath]} {\n" +" uplevel #0 [list source $pkgpath]\n" +" return\n" +" }\n" +" }\n" +" }\n" +"}\n" +); +} +int Jim_initjimshInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "initjimsh", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "initjimsh.tcl", 1, +"\n" +"\n" +"\n" +"proc _jimsh_init {} {\n" +" rename _jimsh_init {}\n" +" global jim::exe jim::argv0 tcl_interactive auto_path tcl_platform\n" +"\n" +"\n" +" if {[exists jim::argv0]} {\n" +" if {[string match \"*/*\" $jim::argv0]} {\n" +" set jim::exe [file join [pwd] $jim::argv0]\n" +" } else {\n" +" foreach path [split [env PATH \"\"] $tcl_platform(pathSeparator)] {\n" +" set exec [file join [pwd] [string map {\\\\ /} $path] $jim::argv0]\n" +" if {[file executable $exec]} {\n" +" set jim::exe $exec\n" +" break\n" +" }\n" +" }\n" +" }\n" +" }\n" +"\n" +"\n" +" lappend p {*}[split [env JIMLIB {}] $tcl_platform(pathSeparator)]\n" +" if {[exists jim::exe]} {\n" +" lappend p [file dirname $jim::exe]\n" +" }\n" +" lappend p {*}$auto_path\n" +" set auto_path $p\n" +"\n" +" if {$tcl_interactive && [env HOME {}] ne \"\"} {\n" +" foreach src {.jimrc jimrc.tcl} {\n" +" if {[file exists [env HOME]/$src]} {\n" +" uplevel #0 source [env HOME]/$src\n" +" break\n" +" }\n" +" }\n" +" }\n" +" return \"\"\n" +"}\n" +"\n" +"if {$tcl_platform(platform) eq \"windows\"} {\n" +" set jim::argv0 [string map {\\\\ /} $jim::argv0]\n" +"}\n" +"\n" +"\n" +"set tcl::autocomplete_commands {info tcl::prefix socket namespace array clock file package string dict signal history}\n" +"\n" +"\n" +"\n" +"proc tcl::autocomplete {prefix} {\n" +" if {[set space [string first \" \" $prefix]] != -1} {\n" +" set cmd [string range $prefix 0 $space-1]\n" +" if {$cmd in $::tcl::autocomplete_commands || [info channel $cmd] ne \"\"} {\n" +" set arg [string range $prefix $space+1 end]\n" +"\n" +" return [lmap p [$cmd -commands] {\n" +" if {![string match \"${arg}*\" $p]} continue\n" +" function \"$cmd $p\"\n" +" }]\n" +" }\n" +" }\n" +"\n" +" if {[string match \"source *\" $prefix]} {\n" +" set path [string range $prefix 7 end]\n" +" return [lmap p [glob -nocomplain \"${path}*\"] {\n" +" function \"source $p\"\n" +" }]\n" +" }\n" +"\n" +" return [lmap p [lsort [info commands $prefix*]] {\n" +" if {[string match \"* *\" $p]} {\n" +" continue\n" +" }\n" +" function $p\n" +" }]\n" +"}\n" +"\n" +"_jimsh_init\n" +); +} +int Jim_globInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "glob", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "glob.tcl", 1, +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"package require readdir\n" +"\n" +"\n" +"proc glob.globdir {dir pattern} {\n" +" if {[file exists $dir/$pattern]} {\n" +"\n" +" return [list $pattern]\n" +" }\n" +"\n" +" set result {}\n" +" set files [readdir $dir]\n" +" lappend files . ..\n" +"\n" +" foreach name $files {\n" +" if {[string match $pattern $name]} {\n" +"\n" +" if {[string index $name 0] eq \".\" && [string index $pattern 0] ne \".\"} {\n" +" continue\n" +" }\n" +" lappend result $name\n" +" }\n" +" }\n" +"\n" +" return $result\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"proc glob.explode {pattern} {\n" +" set oldexp {}\n" +" set newexp {\"\"}\n" +"\n" +" while 1 {\n" +" set oldexp $newexp\n" +" set newexp {}\n" +" set ob [string first \\{ $pattern]\n" +" set cb [string first \\} $pattern]\n" +"\n" +" if {$ob < $cb && $ob != -1} {\n" +" set mid [string range $pattern 0 $ob-1]\n" +" set subexp [lassign [glob.explode [string range $pattern $ob+1 end]] pattern]\n" +" if {$pattern eq \"\"} {\n" +" error \"unmatched open brace in glob pattern\"\n" +" }\n" +" set pattern [string range $pattern 1 end]\n" +"\n" +" foreach subs $subexp {\n" +" foreach sub [split $subs ,] {\n" +" foreach old $oldexp {\n" +" lappend newexp $old$mid$sub\n" +" }\n" +" }\n" +" }\n" +" } elseif {$cb != -1} {\n" +" set suf [string range $pattern 0 $cb-1]\n" +" set rest [string range $pattern $cb end]\n" +" break\n" +" } else {\n" +" set suf $pattern\n" +" set rest \"\"\n" +" break\n" +" }\n" +" }\n" +"\n" +" foreach old $oldexp {\n" +" lappend newexp $old$suf\n" +" }\n" +" list $rest {*}$newexp\n" +"}\n" +"\n" +"\n" +"\n" +"proc glob.glob {base pattern} {\n" +" set dir [file dirname $pattern]\n" +" if {$pattern eq $dir || $pattern eq \"\"} {\n" +" return [list [file join $base $dir] $pattern]\n" +" } elseif {$pattern eq [file tail $pattern]} {\n" +" set dir \"\"\n" +" }\n" +"\n" +"\n" +" set dirlist [glob.glob $base $dir]\n" +" set pattern [file tail $pattern]\n" +"\n" +"\n" +" set result {}\n" +" foreach {realdir dir} $dirlist {\n" +" if {![file isdir $realdir]} {\n" +" continue\n" +" }\n" +" if {[string index $dir end] ne \"/\" && $dir ne \"\"} {\n" +" append dir /\n" +" }\n" +" foreach name [glob.globdir $realdir $pattern] {\n" +" lappend result [file join $realdir $name] $dir$name\n" +" }\n" +" }\n" +" return $result\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"proc glob {args} {\n" +" set nocomplain 0\n" +" set base \"\"\n" +" set tails 0\n" +"\n" +" set n 0\n" +" foreach arg $args {\n" +" if {[info exists param]} {\n" +" set $param $arg\n" +" unset param\n" +" incr n\n" +" continue\n" +" }\n" +" switch -glob -- $arg {\n" +" -d* {\n" +" set switch $arg\n" +" set param base\n" +" }\n" +" -n* {\n" +" set nocomplain 1\n" +" }\n" +" -ta* {\n" +" set tails 1\n" +" }\n" +" -- {\n" +" incr n\n" +" break\n" +" }\n" +" -* {\n" +" return -code error \"bad option \\\"$arg\\\": must be -directory, -nocomplain, -tails, or --\"\n" +" }\n" +" * {\n" +" break\n" +" }\n" +" }\n" +" incr n\n" +" }\n" +" if {[info exists param]} {\n" +" return -code error \"missing argument to \\\"$switch\\\"\"\n" +" }\n" +" if {[llength $args] <= $n} {\n" +" return -code error \"wrong # args: should be \\\"glob ?options? pattern ?pattern ...?\\\"\"\n" +" }\n" +"\n" +" set args [lrange $args $n end]\n" +"\n" +" set result {}\n" +" foreach pattern $args {\n" +" set escpattern [string map {\n" +" \\\\\\\\ \\x01 \\\\\\{ \\x02 \\\\\\} \\x03 \\\\, \\x04\n" +" } $pattern]\n" +" set patexps [lassign [glob.explode $escpattern] rest]\n" +" if {$rest ne \"\"} {\n" +" return -code error \"unmatched close brace in glob pattern\"\n" +" }\n" +" foreach patexp $patexps {\n" +" set patexp [string map {\n" +" \\x01 \\\\\\\\ \\x02 \\{ \\x03 \\} \\x04 ,\n" +" } $patexp]\n" +" foreach {realname name} [glob.glob $base $patexp] {\n" +" incr n\n" +" if {$tails} {\n" +" lappend result $name\n" +" } else {\n" +" lappend result [file join $base $name]\n" +" }\n" +" }\n" +" }\n" +" }\n" +"\n" +" if {!$nocomplain && [llength $result] == 0} {\n" +" set s $(([llength $args] > 1) ? \"s\" : \"\")\n" +" return -code error \"no files matched glob pattern$s \\\"[join $args]\\\"\"\n" +" }\n" +"\n" +" return $result\n" +"}\n" +); +} +int Jim_stdlibInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "stdlib", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "stdlib.tcl", 1, +"\n" +"\n" +"if {![exists -command ref]} {\n" +"\n" +" proc ref {args} {{count 0}} {\n" +" format %08x [incr count]\n" +" }\n" +"}\n" +"\n" +"\n" +"proc lambda {arglist args} {\n" +" tailcall proc [ref {} function lambda.finalizer] $arglist {*}$args\n" +"}\n" +"\n" +"proc lambda.finalizer {name val} {\n" +" rename $name {}\n" +"}\n" +"\n" +"\n" +"proc curry {args} {\n" +" alias [ref {} function lambda.finalizer] {*}$args\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"proc function {value} {\n" +" return $value\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"proc stacktrace {{skip 0}} {\n" +" set trace {}\n" +" incr skip\n" +" foreach level [range $skip [info level]] {\n" +" lappend trace {*}[info frame -$level]\n" +" }\n" +" return $trace\n" +"}\n" +"\n" +"\n" +"proc stackdump {stacktrace} {\n" +" set lines {}\n" +" foreach {l f p} [lreverse $stacktrace] {\n" +" set line {}\n" +" if {$p ne \"\"} {\n" +" append line \"in procedure '$p' \"\n" +" if {$f ne \"\"} {\n" +" append line \"called \"\n" +" }\n" +" }\n" +" if {$f ne \"\"} {\n" +" append line \"at file \\\"$f\\\", line $l\"\n" +" }\n" +" if {$line ne \"\"} {\n" +" lappend lines $line\n" +" }\n" +" }\n" +" join $lines \\n\n" +"}\n" +"\n" +"\n" +"\n" +"proc defer {script} {\n" +" upvar jim::defer v\n" +" lappend v $script\n" +"}\n" +"\n" +"\n" +"\n" +"proc errorInfo {msg {stacktrace \"\"}} {\n" +" if {$stacktrace eq \"\"} {\n" +"\n" +" set stacktrace [info stacktrace]\n" +"\n" +" lappend stacktrace {*}[stacktrace 1]\n" +" }\n" +" lassign $stacktrace p f l\n" +" if {$f ne \"\"} {\n" +" set result \"$f:$l: Error: \"\n" +" }\n" +" append result \"$msg\\n\"\n" +" append result [stackdump $stacktrace]\n" +"\n" +"\n" +" string trim $result\n" +"}\n" +"\n" +"\n" +"\n" +"proc {info nameofexecutable} {} {\n" +" if {[exists ::jim::exe]} {\n" +" return $::jim::exe\n" +" }\n" +"}\n" +"\n" +"\n" +"proc {dict update} {&varName args script} {\n" +" set keys {}\n" +" foreach {n v} $args {\n" +" upvar $v var_$v\n" +" if {[dict exists $varName $n]} {\n" +" set var_$v [dict get $varName $n]\n" +" }\n" +" }\n" +" catch {uplevel 1 $script} msg opts\n" +" if {[info exists varName]} {\n" +" foreach {n v} $args {\n" +" if {[info exists var_$v]} {\n" +" dict set varName $n [set var_$v]\n" +" } else {\n" +" dict unset varName $n\n" +" }\n" +" }\n" +" }\n" +" return {*}$opts $msg\n" +"}\n" +"\n" +"proc {dict replace} {dictionary {args {key value}}} {\n" +" if {[llength ${key value}] % 2} {\n" +" tailcall {dict replace}\n" +" }\n" +" tailcall dict merge $dictionary ${key value}\n" +"}\n" +"\n" +"\n" +"proc {dict lappend} {varName key {args value}} {\n" +" upvar $varName dict\n" +" if {[exists dict] && [dict exists $dict $key]} {\n" +" set list [dict get $dict $key]\n" +" }\n" +" lappend list {*}$value\n" +" dict set dict $key $list\n" +"}\n" +"\n" +"\n" +"proc {dict append} {varName key {args value}} {\n" +" upvar $varName dict\n" +" if {[exists dict] && [dict exists $dict $key]} {\n" +" set str [dict get $dict $key]\n" +" }\n" +" append str {*}$value\n" +" dict set dict $key $str\n" +"}\n" +"\n" +"\n" +"proc {dict incr} {varName key {increment 1}} {\n" +" upvar $varName dict\n" +" if {[exists dict] && [dict exists $dict $key]} {\n" +" set value [dict get $dict $key]\n" +" }\n" +" incr value $increment\n" +" dict set dict $key $value\n" +"}\n" +"\n" +"\n" +"proc {dict remove} {dictionary {args key}} {\n" +" foreach k $key {\n" +" dict unset dictionary $k\n" +" }\n" +" return $dictionary\n" +"}\n" +"\n" +"\n" +"proc {dict for} {vars dictionary script} {\n" +" if {[llength $vars] != 2} {\n" +" return -code error \"must have exactly two variable names\"\n" +" }\n" +" dict size $dictionary\n" +" tailcall foreach $vars $dictionary $script\n" +"}\n" +); +} +int Jim_tclcompatInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "tclcompat", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "tclcompat.tcl", 1, +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"set env [env]\n" +"\n" +"\n" +"if {[info commands stdout] ne \"\"} {\n" +"\n" +" foreach p {gets flush close eof seek tell} {\n" +" proc $p {chan args} {p} {\n" +" tailcall $chan $p {*}$args\n" +" }\n" +" }\n" +" unset p\n" +"\n" +"\n" +"\n" +" proc puts {{-nonewline {}} {chan stdout} msg} {\n" +" if {${-nonewline} ni {-nonewline {}}} {\n" +" tailcall ${-nonewline} puts $msg\n" +" }\n" +" tailcall $chan puts {*}${-nonewline} $msg\n" +" }\n" +"\n" +"\n" +"\n" +"\n" +"\n" +" proc read {{-nonewline {}} chan} {\n" +" if {${-nonewline} ni {-nonewline {}}} {\n" +" tailcall ${-nonewline} read {*}${chan}\n" +" }\n" +" tailcall $chan read {*}${-nonewline}\n" +" }\n" +"\n" +" proc fconfigure {f args} {\n" +" foreach {n v} $args {\n" +" switch -glob -- $n {\n" +" -bl* {\n" +" $f ndelay $(!$v)\n" +" }\n" +" -bu* {\n" +" $f buffering $v\n" +" }\n" +" -tr* {\n" +"\n" +" }\n" +" default {\n" +" return -code error \"fconfigure: unknown option $n\"\n" +" }\n" +" }\n" +" }\n" +" }\n" +"}\n" +"\n" +"\n" +"proc fileevent {args} {\n" +" tailcall {*}$args\n" +"}\n" +"\n" +"\n" +"\n" +"proc parray {arrayname {pattern *} {puts puts}} {\n" +" upvar $arrayname a\n" +"\n" +" set max 0\n" +" foreach name [array names a $pattern]] {\n" +" if {[string length $name] > $max} {\n" +" set max [string length $name]\n" +" }\n" +" }\n" +" incr max [string length $arrayname]\n" +" incr max 2\n" +" foreach name [lsort [array names a $pattern]] {\n" +" $puts [format \"%-${max}s = %s\" $arrayname\\($name\\) $a($name)]\n" +" }\n" +"}\n" +"\n" +"\n" +"proc {file copy} {{force {}} source target} {\n" +" try {\n" +" if {$force ni {{} -force}} {\n" +" error \"bad option \\\"$force\\\": should be -force\"\n" +" }\n" +"\n" +" set in [open $source rb]\n" +"\n" +" if {[file exists $target]} {\n" +" if {$force eq \"\"} {\n" +" error \"error copying \\\"$source\\\" to \\\"$target\\\": file already exists\"\n" +" }\n" +"\n" +" if {$source eq $target} {\n" +" return\n" +" }\n" +"\n" +"\n" +" file stat $source ss\n" +" file stat $target ts\n" +" if {$ss(dev) == $ts(dev) && $ss(ino) == $ts(ino) && $ss(ino)} {\n" +" return\n" +" }\n" +" }\n" +" set out [open $target wb]\n" +" $in copyto $out\n" +" $out close\n" +" } on error {msg opts} {\n" +" incr opts(-level)\n" +" return {*}$opts $msg\n" +" } finally {\n" +" catch {$in close}\n" +" }\n" +"}\n" +"\n" +"\n" +"\n" +"proc popen {cmd {mode r}} {\n" +" lassign [pipe] r w\n" +" try {\n" +" if {[string match \"w*\" $mode]} {\n" +" lappend cmd <@$r &\n" +" set pids [exec {*}$cmd]\n" +" $r close\n" +" set f $w\n" +" } else {\n" +" lappend cmd >@$w &\n" +" set pids [exec {*}$cmd]\n" +" $w close\n" +" set f $r\n" +" }\n" +" lambda {cmd args} {f pids} {\n" +" if {$cmd eq \"pid\"} {\n" +" return $pids\n" +" }\n" +" if {$cmd eq \"getfd\"} {\n" +" $f getfd\n" +" }\n" +" if {$cmd eq \"close\"} {\n" +" $f close\n" +"\n" +" set retopts {}\n" +" foreach p $pids {\n" +" lassign [wait $p] status - rc\n" +" if {$status eq \"CHILDSTATUS\"} {\n" +" if {$rc == 0} {\n" +" continue\n" +" }\n" +" set msg \"child process exited abnormally\"\n" +" } else {\n" +" set msg \"child killed: received signal\"\n" +" }\n" +" set retopts [list -code error -errorcode [list $status $p $rc] $msg]\n" +" }\n" +" return {*}$retopts\n" +" }\n" +" tailcall $f $cmd {*}$args\n" +" }\n" +" } on error {error opts} {\n" +" $r close\n" +" $w close\n" +" error $error\n" +" }\n" +"}\n" +"\n" +"\n" +"local proc pid {{channelId {}}} {\n" +" if {$channelId eq \"\"} {\n" +" tailcall upcall pid\n" +" }\n" +" if {[catch {$channelId tell}]} {\n" +" return -code error \"can not find channel named \\\"$channelId\\\"\"\n" +" }\n" +" if {[catch {$channelId pid} pids]} {\n" +" return \"\"\n" +" }\n" +" return $pids\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"proc try {args} {\n" +" set catchopts {}\n" +" while {[string match -* [lindex $args 0]]} {\n" +" set args [lassign $args opt]\n" +" if {$opt eq \"--\"} {\n" +" break\n" +" }\n" +" lappend catchopts $opt\n" +" }\n" +" if {[llength $args] == 0} {\n" +" return -code error {wrong # args: should be \"try ?options? script ?argument ...?\"}\n" +" }\n" +" set args [lassign $args script]\n" +" set code [catch -eval {*}$catchopts {uplevel 1 $script} msg opts]\n" +"\n" +" set handled 0\n" +"\n" +" foreach {on codes vars script} $args {\n" +" switch -- $on \\\n" +" on {\n" +" if {!$handled && ($codes eq \"*\" || [info returncode $code] in $codes)} {\n" +" lassign $vars msgvar optsvar\n" +" if {$msgvar ne \"\"} {\n" +" upvar $msgvar hmsg\n" +" set hmsg $msg\n" +" }\n" +" if {$optsvar ne \"\"} {\n" +" upvar $optsvar hopts\n" +" set hopts $opts\n" +" }\n" +"\n" +" set code [catch {uplevel 1 $script} msg opts]\n" +" incr handled\n" +" }\n" +" } \\\n" +" finally {\n" +" set finalcode [catch {uplevel 1 $codes} finalmsg finalopts]\n" +" if {$finalcode} {\n" +"\n" +" set code $finalcode\n" +" set msg $finalmsg\n" +" set opts $finalopts\n" +" }\n" +" break\n" +" } \\\n" +" default {\n" +" return -code error \"try: expected 'on' or 'finally', got '$on'\"\n" +" }\n" +" }\n" +"\n" +" if {$code} {\n" +" incr opts(-level)\n" +" return {*}$opts $msg\n" +" }\n" +" return $msg\n" +"}\n" +"\n" +"\n" +"\n" +"proc throw {code {msg \"\"}} {\n" +" return -code $code $msg\n" +"}\n" +"\n" +"\n" +"proc {file delete force} {path} {\n" +" foreach e [readdir $path] {\n" +" file delete -force $path/$e\n" +" }\n" +" file delete $path\n" +"}\n" +); +} + + +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif +#include +#include +#include +#include +#ifdef HAVE_UNISTD_H +#include +#include +#endif + + +#if defined(HAVE_SYS_SOCKET_H) && defined(HAVE_SELECT) && defined(HAVE_NETINET_IN_H) && defined(HAVE_NETDB_H) && defined(HAVE_ARPA_INET_H) +#include +#include +#include +#include +#include +#ifdef HAVE_SYS_UN_H +#include +#endif +#define HAVE_SOCKETS +#elif defined (__MINGW32__) + +#else +#define JIM_ANSIC +#endif + +#if defined(JIM_SSL) +#include +#include +#endif + +#ifdef HAVE_TERMIOS_H +#endif + + +#define AIO_CMD_LEN 32 +#define AIO_BUF_LEN 256 + +#ifndef HAVE_FTELLO + #define ftello ftell +#endif +#ifndef HAVE_FSEEKO + #define fseeko fseek +#endif + +#define AIO_KEEPOPEN 1 + +#if defined(JIM_IPV6) +#define IPV6 1 +#else +#define IPV6 0 +#ifndef PF_INET6 +#define PF_INET6 0 +#endif +#endif + +#ifdef JIM_ANSIC + +#undef HAVE_PIPE +#undef HAVE_SOCKETPAIR +#endif + + +struct AioFile; + +typedef struct { + int (*writer)(struct AioFile *af, const char *buf, int len); + int (*reader)(struct AioFile *af, char *buf, int len); + const char *(*getline)(struct AioFile *af, char *buf, int len); + int (*error)(const struct AioFile *af); + const char *(*strerror)(struct AioFile *af); + int (*verify)(struct AioFile *af); +} JimAioFopsType; + +typedef struct AioFile +{ + FILE *fp; + Jim_Obj *filename; + int type; + int openFlags; + int fd; + Jim_Obj *rEvent; + Jim_Obj *wEvent; + Jim_Obj *eEvent; + int addr_family; + void *ssl; + const JimAioFopsType *fops; +} AioFile; + +static int stdio_writer(struct AioFile *af, const char *buf, int len) +{ + return fwrite(buf, 1, len, af->fp); +} + +static int stdio_reader(struct AioFile *af, char *buf, int len) +{ + return fread(buf, 1, len, af->fp); +} + +static const char *stdio_getline(struct AioFile *af, char *buf, int len) +{ + return fgets(buf, len, af->fp); +} + +static int stdio_error(const AioFile *af) +{ + if (!ferror(af->fp)) { + return JIM_OK; + } + clearerr(af->fp); + + if (feof(af->fp) || errno == EAGAIN || errno == EINTR) { + return JIM_OK; + } +#ifdef ECONNRESET + if (errno == ECONNRESET) { + return JIM_OK; + } +#endif +#ifdef ECONNABORTED + if (errno == ECONNABORTED) { + return JIM_OK; + } +#endif + return JIM_ERR; +} + +static const char *stdio_strerror(struct AioFile *af) +{ + return strerror(errno); +} + +static const JimAioFopsType stdio_fops = { + stdio_writer, + stdio_reader, + stdio_getline, + stdio_error, + stdio_strerror, + NULL +}; + + +static int JimAioSubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv); +static AioFile *JimMakeChannel(Jim_Interp *interp, FILE *fh, int fd, Jim_Obj *filename, + const char *hdlfmt, int family, const char *mode); + + +static const char *JimAioErrorString(AioFile *af) +{ + if (af && af->fops) + return af->fops->strerror(af); + + return strerror(errno); +} + +static void JimAioSetError(Jim_Interp *interp, Jim_Obj *name) +{ + AioFile *af = Jim_CmdPrivData(interp); + + if (name) { + Jim_SetResultFormatted(interp, "%#s: %s", name, JimAioErrorString(af)); + } + else { + Jim_SetResultString(interp, JimAioErrorString(af), -1); + } +} + +static int JimCheckStreamError(Jim_Interp *interp, AioFile *af) +{ + int ret = af->fops->error(af); + if (ret) { + JimAioSetError(interp, af->filename); + } + return ret; +} + +static void JimAioDelProc(Jim_Interp *interp, void *privData) +{ + AioFile *af = privData; + + JIM_NOTUSED(interp); + + Jim_DecrRefCount(interp, af->filename); + +#ifdef jim_ext_eventloop + + Jim_DeleteFileHandler(interp, af->fd, JIM_EVENT_READABLE | JIM_EVENT_WRITABLE | JIM_EVENT_EXCEPTION); +#endif + +#if defined(JIM_SSL) + if (af->ssl != NULL) { + SSL_free(af->ssl); + } +#endif + if (!(af->openFlags & AIO_KEEPOPEN)) { + fclose(af->fp); + } + + Jim_Free(af); +} + +static int aio_cmd_read(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + char buf[AIO_BUF_LEN]; + Jim_Obj *objPtr; + int nonewline = 0; + jim_wide neededLen = -1; + + if (argc && Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) { + nonewline = 1; + argv++; + argc--; + } + if (argc == 1) { + if (Jim_GetWide(interp, argv[0], &neededLen) != JIM_OK) + return JIM_ERR; + if (neededLen < 0) { + Jim_SetResultString(interp, "invalid parameter: negative len", -1); + return JIM_ERR; + } + } + else if (argc) { + return -1; + } + objPtr = Jim_NewStringObj(interp, NULL, 0); + while (neededLen != 0) { + int retval; + int readlen; + + if (neededLen == -1) { + readlen = AIO_BUF_LEN; + } + else { + readlen = (neededLen > AIO_BUF_LEN ? AIO_BUF_LEN : neededLen); + } + retval = af->fops->reader(af, buf, readlen); + if (retval > 0) { + Jim_AppendString(interp, objPtr, buf, retval); + if (neededLen != -1) { + neededLen -= retval; + } + } + if (retval != readlen) + break; + } + + if (JimCheckStreamError(interp, af)) { + Jim_FreeNewObj(interp, objPtr); + return JIM_ERR; + } + if (nonewline) { + int len; + const char *s = Jim_GetString(objPtr, &len); + + if (len > 0 && s[len - 1] == '\n') { + objPtr->length--; + objPtr->bytes[objPtr->length] = '\0'; + } + } + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + +AioFile *Jim_AioFile(Jim_Interp *interp, Jim_Obj *command) +{ + Jim_Cmd *cmdPtr = Jim_GetCommand(interp, command, JIM_ERRMSG); + + + if (cmdPtr && !cmdPtr->isproc && cmdPtr->u.native.cmdProc == JimAioSubCmdProc) { + return (AioFile *) cmdPtr->u.native.privData; + } + Jim_SetResultFormatted(interp, "Not a filehandle: \"%#s\"", command); + return NULL; +} + +FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *command) +{ + AioFile *af; + + af = Jim_AioFile(interp, command); + if (af == NULL) { + return NULL; + } + + return af->fp; +} + +static int aio_cmd_getfd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + fflush(af->fp); + Jim_SetResultInt(interp, fileno(af->fp)); + + return JIM_OK; +} + +static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + jim_wide count = 0; + jim_wide maxlen = JIM_WIDE_MAX; + AioFile *outf = Jim_AioFile(interp, argv[0]); + + if (outf == NULL) { + return JIM_ERR; + } + + if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &maxlen) != JIM_OK) { + return JIM_ERR; + } + } + + while (count < maxlen) { + char ch; + + if (af->fops->reader(af, &ch, 1) != 1) { + break; + } + if (outf->fops->writer(outf, &ch, 1) != 1) { + break; + } + count++; + } + + if (JimCheckStreamError(interp, af) || JimCheckStreamError(interp, outf)) { + return JIM_ERR; + } + + Jim_SetResultInt(interp, count); + + return JIM_OK; +} + +static int aio_cmd_gets(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + char buf[AIO_BUF_LEN]; + Jim_Obj *objPtr; + int len; + + errno = 0; + + objPtr = Jim_NewStringObj(interp, NULL, 0); + while (1) { + buf[AIO_BUF_LEN - 1] = '_'; + + if (af->fops->getline(af, buf, AIO_BUF_LEN) == NULL) + break; + + if (buf[AIO_BUF_LEN - 1] == '\0' && buf[AIO_BUF_LEN - 2] != '\n') { + Jim_AppendString(interp, objPtr, buf, AIO_BUF_LEN - 1); + } + else { + len = strlen(buf); + + if (len && (buf[len - 1] == '\n')) { + + len--; + } + + Jim_AppendString(interp, objPtr, buf, len); + break; + } + } + + if (JimCheckStreamError(interp, af)) { + + Jim_FreeNewObj(interp, objPtr); + return JIM_ERR; + } + + if (argc) { + if (Jim_SetVariable(interp, argv[0], objPtr) != JIM_OK) { + Jim_FreeNewObj(interp, objPtr); + return JIM_ERR; + } + + len = Jim_Length(objPtr); + + if (len == 0 && feof(af->fp)) { + + len = -1; + } + Jim_SetResultInt(interp, len); + } + else { + Jim_SetResult(interp, objPtr); + } + return JIM_OK; +} + +static int aio_cmd_puts(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + int wlen; + const char *wdata; + Jim_Obj *strObj; + + if (argc == 2) { + if (!Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) { + return -1; + } + strObj = argv[1]; + } + else { + strObj = argv[0]; + } + + wdata = Jim_GetString(strObj, &wlen); + if (af->fops->writer(af, wdata, wlen) == wlen) { + if (argc == 2 || af->fops->writer(af, "\n", 1) == 1) { + return JIM_OK; + } + } + JimAioSetError(interp, af->filename); + return JIM_ERR; +} + +static int aio_cmd_isatty(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ +#ifdef HAVE_ISATTY + AioFile *af = Jim_CmdPrivData(interp); + Jim_SetResultInt(interp, isatty(fileno(af->fp))); +#else + Jim_SetResultInt(interp, 0); +#endif + + return JIM_OK; +} + + +static int aio_cmd_flush(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + if (fflush(af->fp) == EOF) { + JimAioSetError(interp, af->filename); + return JIM_ERR; + } + return JIM_OK; +} + +static int aio_cmd_eof(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + Jim_SetResultInt(interp, feof(af->fp)); + return JIM_OK; +} + +static int aio_cmd_close(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc == 3) { +#if defined(HAVE_SOCKETS) && defined(HAVE_SHUTDOWN) + static const char * const options[] = { "r", "w", NULL }; + enum { OPT_R, OPT_W, }; + int option; + AioFile *af = Jim_CmdPrivData(interp); + + if (Jim_GetEnum(interp, argv[2], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + if (shutdown(af->fd, option == OPT_R ? SHUT_RD : SHUT_WR) == 0) { + return JIM_OK; + } + JimAioSetError(interp, NULL); +#else + Jim_SetResultString(interp, "async close not supported", -1); +#endif + return JIM_ERR; + } + + return Jim_DeleteCommand(interp, Jim_String(argv[0])); +} + +static int aio_cmd_seek(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + int orig = SEEK_SET; + jim_wide offset; + + if (argc == 2) { + if (Jim_CompareStringImmediate(interp, argv[1], "start")) + orig = SEEK_SET; + else if (Jim_CompareStringImmediate(interp, argv[1], "current")) + orig = SEEK_CUR; + else if (Jim_CompareStringImmediate(interp, argv[1], "end")) + orig = SEEK_END; + else { + return -1; + } + } + if (Jim_GetWide(interp, argv[0], &offset) != JIM_OK) { + return JIM_ERR; + } + if (fseeko(af->fp, offset, orig) == -1) { + JimAioSetError(interp, af->filename); + return JIM_ERR; + } + return JIM_OK; +} + +static int aio_cmd_tell(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + Jim_SetResultInt(interp, ftello(af->fp)); + return JIM_OK; +} + +static int aio_cmd_filename(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + Jim_SetResult(interp, af->filename); + return JIM_OK; +} + +#ifdef O_NDELAY +static int aio_cmd_ndelay(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + int fmode = fcntl(af->fd, F_GETFL); + + if (argc) { + long nb; + + if (Jim_GetLong(interp, argv[0], &nb) != JIM_OK) { + return JIM_ERR; + } + if (nb) { + fmode |= O_NDELAY; + } + else { + fmode &= ~O_NDELAY; + } + (void)fcntl(af->fd, F_SETFL, fmode); + } + Jim_SetResultInt(interp, (fmode & O_NONBLOCK) ? 1 : 0); + return JIM_OK; +} +#endif + + +#ifdef HAVE_FSYNC +static int aio_cmd_sync(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + fflush(af->fp); + fsync(af->fd); + return JIM_OK; +} +#endif + +static int aio_cmd_buffering(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + static const char * const options[] = { + "none", + "line", + "full", + NULL + }; + enum + { + OPT_NONE, + OPT_LINE, + OPT_FULL, + }; + int option; + + if (Jim_GetEnum(interp, argv[0], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_NONE: + setvbuf(af->fp, NULL, _IONBF, 0); + break; + case OPT_LINE: + setvbuf(af->fp, NULL, _IOLBF, BUFSIZ); + break; + case OPT_FULL: + setvbuf(af->fp, NULL, _IOFBF, BUFSIZ); + break; + } + return JIM_OK; +} + +#ifdef jim_ext_eventloop +static void JimAioFileEventFinalizer(Jim_Interp *interp, void *clientData) +{ + Jim_Obj **objPtrPtr = clientData; + + Jim_DecrRefCount(interp, *objPtrPtr); + *objPtrPtr = NULL; +} + +static int JimAioFileEventHandler(Jim_Interp *interp, void *clientData, int mask) +{ + Jim_Obj **objPtrPtr = clientData; + + return Jim_EvalObjBackground(interp, *objPtrPtr); +} + +static int aio_eventinfo(Jim_Interp *interp, AioFile * af, unsigned mask, Jim_Obj **scriptHandlerObj, + int argc, Jim_Obj * const *argv) +{ + if (argc == 0) { + + if (*scriptHandlerObj) { + Jim_SetResult(interp, *scriptHandlerObj); + } + return JIM_OK; + } + + if (*scriptHandlerObj) { + + Jim_DeleteFileHandler(interp, af->fd, mask); + } + + + if (Jim_Length(argv[0]) == 0) { + + return JIM_OK; + } + + + Jim_IncrRefCount(argv[0]); + *scriptHandlerObj = argv[0]; + + Jim_CreateFileHandler(interp, af->fd, mask, + JimAioFileEventHandler, scriptHandlerObj, JimAioFileEventFinalizer); + + return JIM_OK; +} + +static int aio_cmd_readable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + return aio_eventinfo(interp, af, JIM_EVENT_READABLE, &af->rEvent, argc, argv); +} + +static int aio_cmd_writable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + return aio_eventinfo(interp, af, JIM_EVENT_WRITABLE, &af->wEvent, argc, argv); +} + +static int aio_cmd_onexception(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + return aio_eventinfo(interp, af, JIM_EVENT_EXCEPTION, &af->eEvent, argc, argv); +} +#endif + + + + +static const jim_subcmd_type aio_command_table[] = { + { "read", + "?-nonewline? ?len?", + aio_cmd_read, + 0, + 2, + + }, + { "copyto", + "handle ?size?", + aio_cmd_copy, + 1, + 2, + + }, + { "getfd", + NULL, + aio_cmd_getfd, + 0, + 0, + + }, + { "gets", + "?var?", + aio_cmd_gets, + 0, + 1, + + }, + { "puts", + "?-nonewline? str", + aio_cmd_puts, + 1, + 2, + + }, + { "isatty", + NULL, + aio_cmd_isatty, + 0, + 0, + + }, + { "flush", + NULL, + aio_cmd_flush, + 0, + 0, + + }, + { "eof", + NULL, + aio_cmd_eof, + 0, + 0, + + }, + { "close", + "?r(ead)|w(rite)?", + aio_cmd_close, + 0, + 1, + JIM_MODFLAG_FULLARGV, + + }, + { "seek", + "offset ?start|current|end", + aio_cmd_seek, + 1, + 2, + + }, + { "tell", + NULL, + aio_cmd_tell, + 0, + 0, + + }, + { "filename", + NULL, + aio_cmd_filename, + 0, + 0, + + }, +#ifdef O_NDELAY + { "ndelay", + "?0|1?", + aio_cmd_ndelay, + 0, + 1, + + }, +#endif +#ifdef HAVE_FSYNC + { "sync", + NULL, + aio_cmd_sync, + 0, + 0, + + }, +#endif + { "buffering", + "none|line|full", + aio_cmd_buffering, + 1, + 1, + + }, +#ifdef jim_ext_eventloop + { "readable", + "?readable-script?", + aio_cmd_readable, + 0, + 1, + + }, + { "writable", + "?writable-script?", + aio_cmd_writable, + 0, + 1, + + }, + { "onexception", + "?exception-script?", + aio_cmd_onexception, + 0, + 1, + + }, +#endif + { NULL } +}; + +static int JimAioSubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return Jim_CallSubCmd(interp, Jim_ParseSubCmd(interp, aio_command_table, argc, argv), argc, argv); +} + +static int JimAioOpenCommand(Jim_Interp *interp, int argc, + Jim_Obj *const *argv) +{ + const char *mode; + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "filename ?mode?"); + return JIM_ERR; + } + + mode = (argc == 3) ? Jim_String(argv[2]) : "r"; + +#ifdef jim_ext_tclcompat + { + const char *filename = Jim_String(argv[1]); + + + if (*filename == '|') { + Jim_Obj *evalObj[3]; + + evalObj[0] = Jim_NewStringObj(interp, "::popen", -1); + evalObj[1] = Jim_NewStringObj(interp, filename + 1, -1); + evalObj[2] = Jim_NewStringObj(interp, mode, -1); + + return Jim_EvalObjVector(interp, 3, evalObj); + } + } +#endif + return JimMakeChannel(interp, NULL, -1, argv[1], "aio.handle%ld", 0, mode) ? JIM_OK : JIM_ERR; +} + + +static AioFile *JimMakeChannel(Jim_Interp *interp, FILE *fh, int fd, Jim_Obj *filename, + const char *hdlfmt, int family, const char *mode) +{ + AioFile *af; + char buf[AIO_CMD_LEN]; + int openFlags = 0; + + snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp)); + + if (fh) { + openFlags = AIO_KEEPOPEN; + } + + snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp)); + if (!filename) { + filename = Jim_NewStringObj(interp, buf, -1); + } + + Jim_IncrRefCount(filename); + + if (fh == NULL) { + if (fd >= 0) { +#ifndef JIM_ANSIC + fh = fdopen(fd, mode); +#endif + } + else + fh = fopen(Jim_String(filename), mode); + + if (fh == NULL) { + JimAioSetError(interp, filename); +#ifndef JIM_ANSIC + if (fd >= 0) { + close(fd); + } +#endif + Jim_DecrRefCount(interp, filename); + return NULL; + } + } + + + af = Jim_Alloc(sizeof(*af)); + memset(af, 0, sizeof(*af)); + af->fp = fh; + af->filename = filename; + af->openFlags = openFlags; +#ifndef JIM_ANSIC + af->fd = fileno(fh); +#ifdef FD_CLOEXEC + if ((openFlags & AIO_KEEPOPEN) == 0) { + (void)fcntl(af->fd, F_SETFD, FD_CLOEXEC); + } +#endif +#endif + af->addr_family = family; + af->fops = &stdio_fops; + af->ssl = NULL; + + Jim_CreateCommand(interp, buf, JimAioSubCmdProc, af, JimAioDelProc); + + Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); + + return af; +} + +#if defined(HAVE_PIPE) || (defined(HAVE_SOCKETPAIR) && defined(HAVE_SYS_UN_H)) +static int JimMakeChannelPair(Jim_Interp *interp, int p[2], Jim_Obj *filename, + const char *hdlfmt, int family, const char *mode[2]) +{ + if (JimMakeChannel(interp, NULL, p[0], filename, hdlfmt, family, mode[0])) { + Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, objPtr, Jim_GetResult(interp)); + if (JimMakeChannel(interp, NULL, p[1], filename, hdlfmt, family, mode[1])) { + Jim_ListAppendElement(interp, objPtr, Jim_GetResult(interp)); + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + } + + + close(p[0]); + close(p[1]); + JimAioSetError(interp, NULL); + return JIM_ERR; +} +#endif + +#ifdef HAVE_PIPE +static int JimAioPipeCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int p[2]; + static const char *mode[2] = { "r", "w" }; + + if (argc != 1) { + Jim_WrongNumArgs(interp, 1, argv, ""); + return JIM_ERR; + } + + if (pipe(p) != 0) { + JimAioSetError(interp, NULL); + return JIM_ERR; + } + + return JimMakeChannelPair(interp, p, argv[0], "aio.pipe%ld", 0, mode); +} +#endif + + + +int Jim_aioInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "aio", "1.0", JIM_ERRMSG)) + return JIM_ERR; + +#if defined(JIM_SSL) + Jim_CreateCommand(interp, "load_ssl_certs", JimAioLoadSSLCertsCommand, NULL, NULL); +#endif + + Jim_CreateCommand(interp, "open", JimAioOpenCommand, NULL, NULL); +#ifdef HAVE_SOCKETS + Jim_CreateCommand(interp, "socket", JimAioSockCommand, NULL, NULL); +#endif +#ifdef HAVE_PIPE + Jim_CreateCommand(interp, "pipe", JimAioPipeCommand, NULL, NULL); +#endif + + + JimMakeChannel(interp, stdin, -1, NULL, "stdin", 0, "r"); + JimMakeChannel(interp, stdout, -1, NULL, "stdout", 0, "w"); + JimMakeChannel(interp, stderr, -1, NULL, "stderr", 0, "w"); + + return JIM_OK; +} + +#include +#include +#include + + +#ifdef HAVE_DIRENT_H +#include +#endif + +int Jim_ReaddirCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *dirPath; + DIR *dirPtr; + struct dirent *entryPtr; + int nocomplain = 0; + + if (argc == 3 && Jim_CompareStringImmediate(interp, argv[1], "-nocomplain")) { + nocomplain = 1; + } + if (argc != 2 && !nocomplain) { + Jim_WrongNumArgs(interp, 1, argv, "?-nocomplain? dirPath"); + return JIM_ERR; + } + + dirPath = Jim_String(argv[1 + nocomplain]); + + dirPtr = opendir(dirPath); + if (dirPtr == NULL) { + if (nocomplain) { + return JIM_OK; + } + Jim_SetResultString(interp, strerror(errno), -1); + return JIM_ERR; + } + else { + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + + while ((entryPtr = readdir(dirPtr)) != NULL) { + if (entryPtr->d_name[0] == '.') { + if (entryPtr->d_name[1] == '\0') { + continue; + } + if ((entryPtr->d_name[1] == '.') && (entryPtr->d_name[2] == '\0')) + continue; + } + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, entryPtr->d_name, -1)); + } + closedir(dirPtr); + + Jim_SetResult(interp, listObj); + + return JIM_OK; + } +} + +int Jim_readdirInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "readdir", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "readdir", Jim_ReaddirCmd, NULL, NULL); + return JIM_OK; +} + +#include +#include + +#if defined(JIM_REGEXP) +#else + #include +#endif + +static void FreeRegexpInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + regfree(objPtr->internalRep.ptrIntValue.ptr); + Jim_Free(objPtr->internalRep.ptrIntValue.ptr); +} + +static const Jim_ObjType regexpObjType = { + "regexp", + FreeRegexpInternalRep, + NULL, + NULL, + JIM_TYPE_NONE +}; + +static regex_t *SetRegexpFromAny(Jim_Interp *interp, Jim_Obj *objPtr, unsigned flags) +{ + regex_t *compre; + const char *pattern; + int ret; + + + if (objPtr->typePtr == ®expObjType && + objPtr->internalRep.ptrIntValue.ptr && objPtr->internalRep.ptrIntValue.int1 == flags) { + + return objPtr->internalRep.ptrIntValue.ptr; + } + + + + + pattern = Jim_String(objPtr); + compre = Jim_Alloc(sizeof(regex_t)); + + if ((ret = regcomp(compre, pattern, REG_EXTENDED | flags)) != 0) { + char buf[100]; + + regerror(ret, compre, buf, sizeof(buf)); + Jim_SetResultFormatted(interp, "couldn't compile regular expression pattern: %s", buf); + regfree(compre); + Jim_Free(compre); + return NULL; + } + + Jim_FreeIntRep(interp, objPtr); + + objPtr->typePtr = ®expObjType; + objPtr->internalRep.ptrIntValue.int1 = flags; + objPtr->internalRep.ptrIntValue.ptr = compre; + + return compre; +} + +int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int opt_indices = 0; + int opt_all = 0; + int opt_inline = 0; + regex_t *regex; + int match, i, j; + int offset = 0; + regmatch_t *pmatch = NULL; + int source_len; + int result = JIM_OK; + const char *pattern; + const char *source_str; + int num_matches = 0; + int num_vars; + Jim_Obj *resultListObj = NULL; + int regcomp_flags = 0; + int eflags = 0; + int option; + enum { + OPT_INDICES, OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_INLINE, OPT_START, OPT_END + }; + static const char * const options[] = { + "-indices", "-nocase", "-line", "-all", "-inline", "-start", "--", NULL + }; + + if (argc < 3) { + wrongNumArgs: + Jim_WrongNumArgs(interp, 1, argv, + "?-switch ...? exp string ?matchVar? ?subMatchVar ...?"); + return JIM_ERR; + } + + for (i = 1; i < argc; i++) { + const char *opt = Jim_String(argv[i]); + + if (*opt != '-') { + break; + } + if (Jim_GetEnum(interp, argv[i], options, &option, "switch", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + if (option == OPT_END) { + i++; + break; + } + switch (option) { + case OPT_INDICES: + opt_indices = 1; + break; + + case OPT_NOCASE: + regcomp_flags |= REG_ICASE; + break; + + case OPT_LINE: + regcomp_flags |= REG_NEWLINE; + break; + + case OPT_ALL: + opt_all = 1; + break; + + case OPT_INLINE: + opt_inline = 1; + break; + + case OPT_START: + if (++i == argc) { + goto wrongNumArgs; + } + if (Jim_GetIndex(interp, argv[i], &offset) != JIM_OK) { + return JIM_ERR; + } + break; + } + } + if (argc - i < 2) { + goto wrongNumArgs; + } + + regex = SetRegexpFromAny(interp, argv[i], regcomp_flags); + if (!regex) { + return JIM_ERR; + } + + pattern = Jim_String(argv[i]); + source_str = Jim_GetString(argv[i + 1], &source_len); + + num_vars = argc - i - 2; + + if (opt_inline) { + if (num_vars) { + Jim_SetResultString(interp, "regexp match variables not allowed when using -inline", + -1); + result = JIM_ERR; + goto done; + } + num_vars = regex->re_nsub + 1; + } + + pmatch = Jim_Alloc((num_vars + 1) * sizeof(*pmatch)); + + if (offset) { + if (offset < 0) { + offset += source_len + 1; + } + if (offset > source_len) { + source_str += source_len; + } + else if (offset > 0) { + source_str += offset; + } + eflags |= REG_NOTBOL; + } + + if (opt_inline) { + resultListObj = Jim_NewListObj(interp, NULL, 0); + } + + next_match: + match = regexec(regex, source_str, num_vars + 1, pmatch, eflags); + if (match >= REG_BADPAT) { + char buf[100]; + + regerror(match, regex, buf, sizeof(buf)); + Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf); + result = JIM_ERR; + goto done; + } + + if (match == REG_NOMATCH) { + goto done; + } + + num_matches++; + + if (opt_all && !opt_inline) { + + goto try_next_match; + } + + + j = 0; + for (i += 2; opt_inline ? j < num_vars : i < argc; i++, j++) { + Jim_Obj *resultObj; + + if (opt_indices) { + resultObj = Jim_NewListObj(interp, NULL, 0); + } + else { + resultObj = Jim_NewStringObj(interp, "", 0); + } + + if (pmatch[j].rm_so == -1) { + if (opt_indices) { + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, -1)); + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, -1)); + } + } + else { + int len = pmatch[j].rm_eo - pmatch[j].rm_so; + + if (opt_indices) { + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, + offset + pmatch[j].rm_so)); + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, + offset + pmatch[j].rm_so + len - 1)); + } + else { + Jim_AppendString(interp, resultObj, source_str + pmatch[j].rm_so, len); + } + } + + if (opt_inline) { + Jim_ListAppendElement(interp, resultListObj, resultObj); + } + else { + + result = Jim_SetVariable(interp, argv[i], resultObj); + + if (result != JIM_OK) { + Jim_FreeObj(interp, resultObj); + break; + } + } + } + + try_next_match: + if (opt_all && (pattern[0] != '^' || (regcomp_flags & REG_NEWLINE)) && *source_str) { + if (pmatch[0].rm_eo) { + offset += pmatch[0].rm_eo; + source_str += pmatch[0].rm_eo; + } + else { + source_str++; + offset++; + } + if (*source_str) { + eflags = REG_NOTBOL; + goto next_match; + } + } + + done: + if (result == JIM_OK) { + if (opt_inline) { + Jim_SetResult(interp, resultListObj); + } + else { + Jim_SetResultInt(interp, num_matches); + } + } + + Jim_Free(pmatch); + return result; +} + +#define MAX_SUB_MATCHES 50 + +int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int regcomp_flags = 0; + int regexec_flags = 0; + int opt_all = 0; + int offset = 0; + regex_t *regex; + const char *p; + int result; + regmatch_t pmatch[MAX_SUB_MATCHES + 1]; + int num_matches = 0; + + int i, j, n; + Jim_Obj *varname; + Jim_Obj *resultObj; + const char *source_str; + int source_len; + const char *replace_str; + int replace_len; + const char *pattern; + int option; + enum { + OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_START, OPT_END + }; + static const char * const options[] = { + "-nocase", "-line", "-all", "-start", "--", NULL + }; + + if (argc < 4) { + wrongNumArgs: + Jim_WrongNumArgs(interp, 1, argv, + "?-switch ...? exp string subSpec ?varName?"); + return JIM_ERR; + } + + for (i = 1; i < argc; i++) { + const char *opt = Jim_String(argv[i]); + + if (*opt != '-') { + break; + } + if (Jim_GetEnum(interp, argv[i], options, &option, "switch", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + if (option == OPT_END) { + i++; + break; + } + switch (option) { + case OPT_NOCASE: + regcomp_flags |= REG_ICASE; + break; + + case OPT_LINE: + regcomp_flags |= REG_NEWLINE; + break; + + case OPT_ALL: + opt_all = 1; + break; + + case OPT_START: + if (++i == argc) { + goto wrongNumArgs; + } + if (Jim_GetIndex(interp, argv[i], &offset) != JIM_OK) { + return JIM_ERR; + } + break; + } + } + if (argc - i != 3 && argc - i != 4) { + goto wrongNumArgs; + } + + regex = SetRegexpFromAny(interp, argv[i], regcomp_flags); + if (!regex) { + return JIM_ERR; + } + pattern = Jim_String(argv[i]); + + source_str = Jim_GetString(argv[i + 1], &source_len); + replace_str = Jim_GetString(argv[i + 2], &replace_len); + varname = argv[i + 3]; + + + resultObj = Jim_NewStringObj(interp, "", 0); + + if (offset) { + if (offset < 0) { + offset += source_len + 1; + } + if (offset > source_len) { + offset = source_len; + } + else if (offset < 0) { + offset = 0; + } + } + + + Jim_AppendString(interp, resultObj, source_str, offset); + + + n = source_len - offset; + p = source_str + offset; + do { + int match = regexec(regex, p, MAX_SUB_MATCHES, pmatch, regexec_flags); + + if (match >= REG_BADPAT) { + char buf[100]; + + regerror(match, regex, buf, sizeof(buf)); + Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf); + return JIM_ERR; + } + if (match == REG_NOMATCH) { + break; + } + + num_matches++; + + Jim_AppendString(interp, resultObj, p, pmatch[0].rm_so); + + + for (j = 0; j < replace_len; j++) { + int idx; + int c = replace_str[j]; + + if (c == '&') { + idx = 0; + } + else if (c == '\\' && j < replace_len) { + c = replace_str[++j]; + if ((c >= '0') && (c <= '9')) { + idx = c - '0'; + } + else if ((c == '\\') || (c == '&')) { + Jim_AppendString(interp, resultObj, replace_str + j, 1); + continue; + } + else { + Jim_AppendString(interp, resultObj, replace_str + j - 1, (j == replace_len) ? 1 : 2); + continue; + } + } + else { + Jim_AppendString(interp, resultObj, replace_str + j, 1); + continue; + } + if ((idx < MAX_SUB_MATCHES) && pmatch[idx].rm_so != -1 && pmatch[idx].rm_eo != -1) { + Jim_AppendString(interp, resultObj, p + pmatch[idx].rm_so, + pmatch[idx].rm_eo - pmatch[idx].rm_so); + } + } + + p += pmatch[0].rm_eo; + n -= pmatch[0].rm_eo; + + + if (!opt_all || n == 0) { + break; + } + + + if ((regcomp_flags & REG_NEWLINE) == 0 && pattern[0] == '^') { + break; + } + + + if (pattern[0] == '\0' && n) { + + Jim_AppendString(interp, resultObj, p, 1); + p++; + n--; + } + + regexec_flags |= REG_NOTBOL; + } while (n); + + Jim_AppendString(interp, resultObj, p, -1); + + + if (argc - i == 4) { + result = Jim_SetVariable(interp, varname, resultObj); + + if (result == JIM_OK) { + Jim_SetResultInt(interp, num_matches); + } + else { + Jim_FreeObj(interp, resultObj); + } + } + else { + Jim_SetResult(interp, resultObj); + result = JIM_OK; + } + + return result; +} + +int Jim_regexpInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "regexp", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "regexp", Jim_RegexpCmd, NULL, NULL); + Jim_CreateCommand(interp, "regsub", Jim_RegsubCmd, NULL, NULL); + return JIM_OK; +} + +#include +#include +#include +#include +#include +#include + + +#ifdef HAVE_UTIMES +#include +#endif +#ifdef HAVE_UNISTD_H +#include +#elif defined(_MSC_VER) +#include +#define F_OK 0 +#define W_OK 2 +#define R_OK 4 +#define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) +#define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) +#endif + +# ifndef MAXPATHLEN +# define MAXPATHLEN JIM_PATH_LEN +# endif + +#if defined(__MINGW32__) || defined(__MSYS__) || defined(_MSC_VER) +#define ISWINDOWS 1 +#else +#define ISWINDOWS 0 +#endif + + +#if defined(HAVE_STRUCT_STAT_ST_MTIMESPEC) + #define STAT_MTIME_US(STAT) ((STAT).st_mtimespec.tv_sec * 1000000ll + (STAT).st_mtimespec.tv_nsec / 1000) +#elif defined(HAVE_STRUCT_STAT_ST_MTIM) + #define STAT_MTIME_US(STAT) ((STAT).st_mtim.tv_sec * 1000000ll + (STAT).st_mtim.tv_nsec / 1000) +#endif + + +static const char *JimGetFileType(int mode) +{ + if (S_ISREG(mode)) { + return "file"; + } + else if (S_ISDIR(mode)) { + return "directory"; + } +#ifdef S_ISCHR + else if (S_ISCHR(mode)) { + return "characterSpecial"; + } +#endif +#ifdef S_ISBLK + else if (S_ISBLK(mode)) { + return "blockSpecial"; + } +#endif +#ifdef S_ISFIFO + else if (S_ISFIFO(mode)) { + return "fifo"; + } +#endif +#ifdef S_ISLNK + else if (S_ISLNK(mode)) { + return "link"; + } +#endif +#ifdef S_ISSOCK + else if (S_ISSOCK(mode)) { + return "socket"; + } +#endif + return "unknown"; +} + +static void AppendStatElement(Jim_Interp *interp, Jim_Obj *listObj, const char *key, jim_wide value) +{ + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, key, -1)); + Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, value)); +} + +static int StoreStatData(Jim_Interp *interp, Jim_Obj *varName, const struct stat *sb) +{ + + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + + AppendStatElement(interp, listObj, "dev", sb->st_dev); + AppendStatElement(interp, listObj, "ino", sb->st_ino); + AppendStatElement(interp, listObj, "mode", sb->st_mode); + AppendStatElement(interp, listObj, "nlink", sb->st_nlink); + AppendStatElement(interp, listObj, "uid", sb->st_uid); + AppendStatElement(interp, listObj, "gid", sb->st_gid); + AppendStatElement(interp, listObj, "size", sb->st_size); + AppendStatElement(interp, listObj, "atime", sb->st_atime); + AppendStatElement(interp, listObj, "mtime", sb->st_mtime); + AppendStatElement(interp, listObj, "ctime", sb->st_ctime); +#ifdef STAT_MTIME_US + AppendStatElement(interp, listObj, "mtimeus", STAT_MTIME_US(*sb)); +#endif + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "type", -1)); + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, JimGetFileType((int)sb->st_mode), -1)); + + + if (varName) { + Jim_Obj *objPtr; + objPtr = Jim_GetVariable(interp, varName, JIM_NONE); + + if (objPtr) { + Jim_Obj *objv[2]; + + objv[0] = objPtr; + objv[1] = listObj; + + objPtr = Jim_DictMerge(interp, 2, objv); + if (objPtr == NULL) { + + Jim_SetResultFormatted(interp, "can't set \"%#s(dev)\": variable isn't array", varName); + Jim_FreeNewObj(interp, listObj); + return JIM_ERR; + } + + Jim_InvalidateStringRep(objPtr); + + Jim_FreeNewObj(interp, listObj); + listObj = objPtr; + } + Jim_SetVariable(interp, varName, listObj); + } + + + Jim_SetResult(interp, listObj); + + return JIM_OK; +} + +static int file_cmd_dirname(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + const char *p = strrchr(path, '/'); + + if (!p && path[0] == '.' && path[1] == '.' && path[2] == '\0') { + Jim_SetResultString(interp, "..", -1); + } else if (!p) { + Jim_SetResultString(interp, ".", -1); + } + else if (p == path) { + Jim_SetResultString(interp, "/", -1); + } + else if (ISWINDOWS && p[-1] == ':') { + + Jim_SetResultString(interp, path, p - path + 1); + } + else { + Jim_SetResultString(interp, path, p - path); + } + return JIM_OK; +} + +static int file_cmd_rootname(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + const char *lastSlash = strrchr(path, '/'); + const char *p = strrchr(path, '.'); + + if (p == NULL || (lastSlash != NULL && lastSlash > p)) { + Jim_SetResult(interp, argv[0]); + } + else { + Jim_SetResultString(interp, path, p - path); + } + return JIM_OK; +} + +static int file_cmd_extension(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + const char *lastSlash = strrchr(path, '/'); + const char *p = strrchr(path, '.'); + + if (p == NULL || (lastSlash != NULL && lastSlash >= p)) { + p = ""; + } + Jim_SetResultString(interp, p, -1); + return JIM_OK; +} + +static int file_cmd_tail(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + const char *lastSlash = strrchr(path, '/'); + + if (lastSlash) { + Jim_SetResultString(interp, lastSlash + 1, -1); + } + else { + Jim_SetResult(interp, argv[0]); + } + return JIM_OK; +} + +static int file_cmd_normalize(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ +#ifdef HAVE_REALPATH + const char *path = Jim_String(argv[0]); + char *newname = Jim_Alloc(MAXPATHLEN + 1); + + if (realpath(path, newname)) { + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, newname, -1)); + return JIM_OK; + } + else { + Jim_Free(newname); + Jim_SetResultFormatted(interp, "can't normalize \"%#s\": %s", argv[0], strerror(errno)); + return JIM_ERR; + } +#else + Jim_SetResultString(interp, "Not implemented", -1); + return JIM_ERR; +#endif +} + +static int file_cmd_join(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + char *newname = Jim_Alloc(MAXPATHLEN + 1); + char *last = newname; + + *newname = 0; + + + for (i = 0; i < argc; i++) { + int len; + const char *part = Jim_GetString(argv[i], &len); + + if (*part == '/') { + + last = newname; + } + else if (ISWINDOWS && strchr(part, ':')) { + + last = newname; + } + else if (part[0] == '.') { + if (part[1] == '/') { + part += 2; + len -= 2; + } + else if (part[1] == 0 && last != newname) { + + continue; + } + } + + + if (last != newname && last[-1] != '/') { + *last++ = '/'; + } + + if (len) { + if (last + len - newname >= MAXPATHLEN) { + Jim_Free(newname); + Jim_SetResultString(interp, "Path too long", -1); + return JIM_ERR; + } + memcpy(last, part, len); + last += len; + } + + + if (last > newname + 1 && last[-1] == '/') { + + if (!ISWINDOWS || !(last > newname + 2 && last[-2] == ':')) { + *--last = 0; + } + } + } + + *last = 0; + + + + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, newname, last - newname)); + + return JIM_OK; +} + +static int file_access(Jim_Interp *interp, Jim_Obj *filename, int mode) +{ + Jim_SetResultBool(interp, access(Jim_String(filename), mode) != -1); + + return JIM_OK; +} + +static int file_cmd_readable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return file_access(interp, argv[0], R_OK); +} + +static int file_cmd_writable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return file_access(interp, argv[0], W_OK); +} + +static int file_cmd_executable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ +#ifdef X_OK + return file_access(interp, argv[0], X_OK); +#else + + Jim_SetResultBool(interp, 1); + return JIM_OK; +#endif +} + +static int file_cmd_exists(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return file_access(interp, argv[0], F_OK); +} + +static int file_cmd_delete(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int force = Jim_CompareStringImmediate(interp, argv[0], "-force"); + + if (force || Jim_CompareStringImmediate(interp, argv[0], "--")) { + argc++; + argv--; + } + + while (argc--) { + const char *path = Jim_String(argv[0]); + + if (unlink(path) == -1 && errno != ENOENT) { + if (rmdir(path) == -1) { + + if (!force || Jim_EvalPrefix(interp, "file delete force", 1, argv) != JIM_OK) { + Jim_SetResultFormatted(interp, "couldn't delete file \"%s\": %s", path, + strerror(errno)); + return JIM_ERR; + } + } + } + argv++; + } + return JIM_OK; +} + +#ifdef HAVE_MKDIR_ONE_ARG +#define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME) +#else +#define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME, 0755) +#endif + +static int mkdir_all(char *path) +{ + int ok = 1; + + + goto first; + + while (ok--) { + + { + char *slash = strrchr(path, '/'); + + if (slash && slash != path) { + *slash = 0; + if (mkdir_all(path) != 0) { + return -1; + } + *slash = '/'; + } + } + first: + if (MKDIR_DEFAULT(path) == 0) { + return 0; + } + if (errno == ENOENT) { + + continue; + } + + if (errno == EEXIST) { + struct stat sb; + + if (stat(path, &sb) == 0 && S_ISDIR(sb.st_mode)) { + return 0; + } + + errno = EEXIST; + } + + break; + } + return -1; +} + +static int file_cmd_mkdir(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + while (argc--) { + char *path = Jim_StrDup(Jim_String(argv[0])); + int rc = mkdir_all(path); + + Jim_Free(path); + if (rc != 0) { + Jim_SetResultFormatted(interp, "can't create directory \"%#s\": %s", argv[0], + strerror(errno)); + return JIM_ERR; + } + argv++; + } + return JIM_OK; +} + +static int file_cmd_tempfile(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int fd = Jim_MakeTempFile(interp, (argc >= 1) ? Jim_String(argv[0]) : NULL, 0); + + if (fd < 0) { + return JIM_ERR; + } + close(fd); + + return JIM_OK; +} + +static int file_cmd_rename(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *source; + const char *dest; + int force = 0; + + if (argc == 3) { + if (!Jim_CompareStringImmediate(interp, argv[0], "-force")) { + return -1; + } + force++; + argv++; + argc--; + } + + source = Jim_String(argv[0]); + dest = Jim_String(argv[1]); + + if (!force && access(dest, F_OK) == 0) { + Jim_SetResultFormatted(interp, "error renaming \"%#s\" to \"%#s\": target exists", argv[0], + argv[1]); + return JIM_ERR; + } + + if (rename(source, dest) != 0) { + Jim_SetResultFormatted(interp, "error renaming \"%#s\" to \"%#s\": %s", argv[0], argv[1], + strerror(errno)); + return JIM_ERR; + } + + return JIM_OK; +} + +#if defined(HAVE_LINK) && defined(HAVE_SYMLINK) +static int file_cmd_link(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int ret; + const char *source; + const char *dest; + static const char * const options[] = { "-hard", "-symbolic", NULL }; + enum { OPT_HARD, OPT_SYMBOLIC, }; + int option = OPT_HARD; + + if (argc == 3) { + if (Jim_GetEnum(interp, argv[0], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + argv++; + argc--; + } + + dest = Jim_String(argv[0]); + source = Jim_String(argv[1]); + + if (option == OPT_HARD) { + ret = link(source, dest); + } + else { + ret = symlink(source, dest); + } + + if (ret != 0) { + Jim_SetResultFormatted(interp, "error linking \"%#s\" to \"%#s\": %s", argv[0], argv[1], + strerror(errno)); + return JIM_ERR; + } + + return JIM_OK; +} +#endif + +static int file_stat(Jim_Interp *interp, Jim_Obj *filename, struct stat *sb) +{ + const char *path = Jim_String(filename); + + if (stat(path, sb) == -1) { + Jim_SetResultFormatted(interp, "could not read \"%#s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + return JIM_OK; +} + +#ifdef HAVE_LSTAT +static int file_lstat(Jim_Interp *interp, Jim_Obj *filename, struct stat *sb) +{ + const char *path = Jim_String(filename); + + if (lstat(path, sb) == -1) { + Jim_SetResultFormatted(interp, "could not read \"%#s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + return JIM_OK; +} +#else +#define file_lstat file_stat +#endif + +static int file_cmd_atime(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultInt(interp, sb.st_atime); + return JIM_OK; +} + +static int JimSetFileTimes(Jim_Interp *interp, const char *filename, jim_wide us) +{ +#ifdef HAVE_UTIMES + struct timeval times[2]; + + times[1].tv_sec = times[0].tv_sec = us / 1000000; + times[1].tv_usec = times[0].tv_usec = us % 1000000; + + if (utimes(filename, times) != 0) { + Jim_SetResultFormatted(interp, "can't set time on \"%s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + return JIM_OK; +#else + Jim_SetResultString(interp, "Not implemented", -1); + return JIM_ERR; +#endif +} + +static int file_cmd_mtime(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (argc == 2) { + jim_wide secs; + if (Jim_GetWide(interp, argv[1], &secs) != JIM_OK) { + return JIM_ERR; + } + return JimSetFileTimes(interp, Jim_String(argv[0]), secs * 1000000); + } + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultInt(interp, sb.st_mtime); + return JIM_OK; +} + +#ifdef STAT_MTIME_US +static int file_cmd_mtimeus(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (argc == 2) { + jim_wide us; + if (Jim_GetWide(interp, argv[1], &us) != JIM_OK) { + return JIM_ERR; + } + return JimSetFileTimes(interp, Jim_String(argv[0]), us); + } + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultInt(interp, STAT_MTIME_US(sb)); + return JIM_OK; +} +#endif + +static int file_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return Jim_EvalPrefix(interp, "file copy", argc, argv); +} + +static int file_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultInt(interp, sb.st_size); + return JIM_OK; +} + +static int file_cmd_isdirectory(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + int ret = 0; + + if (file_stat(interp, argv[0], &sb) == JIM_OK) { + ret = S_ISDIR(sb.st_mode); + } + Jim_SetResultInt(interp, ret); + return JIM_OK; +} + +static int file_cmd_isfile(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + int ret = 0; + + if (file_stat(interp, argv[0], &sb) == JIM_OK) { + ret = S_ISREG(sb.st_mode); + } + Jim_SetResultInt(interp, ret); + return JIM_OK; +} + +#ifdef HAVE_GETEUID +static int file_cmd_owned(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + int ret = 0; + + if (file_stat(interp, argv[0], &sb) == JIM_OK) { + ret = (geteuid() == sb.st_uid); + } + Jim_SetResultInt(interp, ret); + return JIM_OK; +} +#endif + +#if defined(HAVE_READLINK) +static int file_cmd_readlink(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + char *linkValue = Jim_Alloc(MAXPATHLEN + 1); + + int linkLength = readlink(path, linkValue, MAXPATHLEN); + + if (linkLength == -1) { + Jim_Free(linkValue); + Jim_SetResultFormatted(interp, "couldn't readlink \"%#s\": %s", argv[0], strerror(errno)); + return JIM_ERR; + } + linkValue[linkLength] = 0; + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, linkValue, linkLength)); + return JIM_OK; +} +#endif + +static int file_cmd_type(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_lstat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultString(interp, JimGetFileType((int)sb.st_mode), -1); + return JIM_OK; +} + +#ifdef HAVE_LSTAT +static int file_cmd_lstat(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_lstat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + return StoreStatData(interp, argc == 2 ? argv[1] : NULL, &sb); +} +#else +#define file_cmd_lstat file_cmd_stat +#endif + +static int file_cmd_stat(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + return StoreStatData(interp, argc == 2 ? argv[1] : NULL, &sb); +} + +static const jim_subcmd_type file_command_table[] = { + { "atime", + "name", + file_cmd_atime, + 1, + 1, + + }, + { "mtime", + "name ?time?", + file_cmd_mtime, + 1, + 2, + + }, +#ifdef STAT_MTIME_US + { "mtimeus", + "name ?time?", + file_cmd_mtimeus, + 1, + 2, + + }, +#endif + { "copy", + "?-force? source dest", + file_cmd_copy, + 2, + 3, + + }, + { "dirname", + "name", + file_cmd_dirname, + 1, + 1, + + }, + { "rootname", + "name", + file_cmd_rootname, + 1, + 1, + + }, + { "extension", + "name", + file_cmd_extension, + 1, + 1, + + }, + { "tail", + "name", + file_cmd_tail, + 1, + 1, + + }, + { "normalize", + "name", + file_cmd_normalize, + 1, + 1, + + }, + { "join", + "name ?name ...?", + file_cmd_join, + 1, + -1, + + }, + { "readable", + "name", + file_cmd_readable, + 1, + 1, + + }, + { "writable", + "name", + file_cmd_writable, + 1, + 1, + + }, + { "executable", + "name", + file_cmd_executable, + 1, + 1, + + }, + { "exists", + "name", + file_cmd_exists, + 1, + 1, + + }, + { "delete", + "?-force|--? name ...", + file_cmd_delete, + 1, + -1, + + }, + { "mkdir", + "dir ...", + file_cmd_mkdir, + 1, + -1, + + }, + { "tempfile", + "?template?", + file_cmd_tempfile, + 0, + 1, + + }, + { "rename", + "?-force? source dest", + file_cmd_rename, + 2, + 3, + + }, +#if defined(HAVE_LINK) && defined(HAVE_SYMLINK) + { "link", + "?-symbolic|-hard? newname target", + file_cmd_link, + 2, + 3, + + }, +#endif +#if defined(HAVE_READLINK) + { "readlink", + "name", + file_cmd_readlink, + 1, + 1, + + }, +#endif + { "size", + "name", + file_cmd_size, + 1, + 1, + + }, + { "stat", + "name ?var?", + file_cmd_stat, + 1, + 2, + + }, + { "lstat", + "name ?var?", + file_cmd_lstat, + 1, + 2, + + }, + { "type", + "name", + file_cmd_type, + 1, + 1, + + }, +#ifdef HAVE_GETEUID + { "owned", + "name", + file_cmd_owned, + 1, + 1, + + }, +#endif + { "isdirectory", + "name", + file_cmd_isdirectory, + 1, + 1, + + }, + { "isfile", + "name", + file_cmd_isfile, + 1, + 1, + + }, + { + NULL + } +}; + +static int Jim_CdCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path; + + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "dirname"); + return JIM_ERR; + } + + path = Jim_String(argv[1]); + + if (chdir(path) != 0) { + Jim_SetResultFormatted(interp, "couldn't change working directory to \"%s\": %s", path, + strerror(errno)); + return JIM_ERR; + } + return JIM_OK; +} + +static int Jim_PwdCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + char *cwd = Jim_Alloc(MAXPATHLEN); + + if (getcwd(cwd, MAXPATHLEN) == NULL) { + Jim_SetResultString(interp, "Failed to get pwd", -1); + Jim_Free(cwd); + return JIM_ERR; + } + else if (ISWINDOWS) { + + char *p = cwd; + while ((p = strchr(p, '\\')) != NULL) { + *p++ = '/'; + } + } + + Jim_SetResultString(interp, cwd, -1); + + Jim_Free(cwd); + return JIM_OK; +} + +int Jim_fileInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "file", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "file", Jim_SubCmdProc, (void *)file_command_table, NULL); + Jim_CreateCommand(interp, "pwd", Jim_PwdCmd, NULL, NULL); + Jim_CreateCommand(interp, "cd", Jim_CdCmd, NULL, NULL); + return JIM_OK; +} + +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif +#include +#include + + +#if (!defined(HAVE_VFORK) || !defined(HAVE_WAITPID)) && !defined(__MINGW32__) +static int Jim_ExecCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *cmdlineObj = Jim_NewEmptyStringObj(interp); + int i, j; + int rc; + + + for (i = 1; i < argc; i++) { + int len; + const char *arg = Jim_GetString(argv[i], &len); + + if (i > 1) { + Jim_AppendString(interp, cmdlineObj, " ", 1); + } + if (strpbrk(arg, "\\\" ") == NULL) { + + Jim_AppendString(interp, cmdlineObj, arg, len); + continue; + } + + Jim_AppendString(interp, cmdlineObj, "\"", 1); + for (j = 0; j < len; j++) { + if (arg[j] == '\\' || arg[j] == '"') { + Jim_AppendString(interp, cmdlineObj, "\\", 1); + } + Jim_AppendString(interp, cmdlineObj, &arg[j], 1); + } + Jim_AppendString(interp, cmdlineObj, "\"", 1); + } + rc = system(Jim_String(cmdlineObj)); + + Jim_FreeNewObj(interp, cmdlineObj); + + if (rc) { + Jim_Obj *errorCode = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, "CHILDSTATUS", -1)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, 0)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, rc)); + Jim_SetGlobalVariableStr(interp, "errorCode", errorCode); + return JIM_ERR; + } + + return JIM_OK; +} + +int Jim_execInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "exec", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "exec", Jim_ExecCmd, NULL, NULL); + return JIM_OK; +} +#else + + +#include +#include +#include + +struct WaitInfoTable; + +static char **JimOriginalEnviron(void); +static char **JimSaveEnv(char **env); +static void JimRestoreEnv(char **env); +static int JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, + pidtype **pidArrayPtr, int *inPipePtr, int *outPipePtr, int *errFilePtr); +static void JimDetachPids(struct WaitInfoTable *table, int numPids, const pidtype *pidPtr); +static int JimCleanupChildren(Jim_Interp *interp, int numPids, pidtype *pidPtr, Jim_Obj *errStrObj); +static int Jim_WaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv); + +#if defined(__MINGW32__) +static pidtype JimStartWinProcess(Jim_Interp *interp, char **argv, char **env, int inputId, int outputId, int errorId); +#endif + +static void Jim_RemoveTrailingNewline(Jim_Obj *objPtr) +{ + int len; + const char *s = Jim_GetString(objPtr, &len); + + if (len > 0 && s[len - 1] == '\n') { + objPtr->length--; + objPtr->bytes[objPtr->length] = '\0'; + } +} + +static int JimAppendStreamToString(Jim_Interp *interp, int fd, Jim_Obj *strObj) +{ + char buf[256]; + FILE *fh = fdopen(fd, "r"); + int ret = 0; + + if (fh == NULL) { + return -1; + } + + while (1) { + int retval = fread(buf, 1, sizeof(buf), fh); + if (retval > 0) { + ret = 1; + Jim_AppendString(interp, strObj, buf, retval); + } + if (retval != sizeof(buf)) { + break; + } + } + fclose(fh); + return ret; +} + +static char **JimBuildEnv(Jim_Interp *interp) +{ + int i; + int size; + int num; + int n; + char **envptr; + char *envdata; + + Jim_Obj *objPtr = Jim_GetGlobalVariableStr(interp, "env", JIM_NONE); + + if (!objPtr) { + return JimOriginalEnviron(); + } + + + + num = Jim_ListLength(interp, objPtr); + if (num % 2) { + + num--; + } + size = Jim_Length(objPtr) + 2; + + envptr = Jim_Alloc(sizeof(*envptr) * (num / 2 + 1) + size); + envdata = (char *)&envptr[num / 2 + 1]; + + n = 0; + for (i = 0; i < num; i += 2) { + const char *s1, *s2; + Jim_Obj *elemObj; + + Jim_ListIndex(interp, objPtr, i, &elemObj, JIM_NONE); + s1 = Jim_String(elemObj); + Jim_ListIndex(interp, objPtr, i + 1, &elemObj, JIM_NONE); + s2 = Jim_String(elemObj); + + envptr[n] = envdata; + envdata += sprintf(envdata, "%s=%s", s1, s2); + envdata++; + n++; + } + envptr[n] = NULL; + *envdata = 0; + + return envptr; +} + +static void JimFreeEnv(char **env, char **original_environ) +{ + if (env != original_environ) { + Jim_Free(env); + } +} + +static Jim_Obj *JimMakeErrorCode(Jim_Interp *interp, pidtype pid, int waitStatus, Jim_Obj *errStrObj) +{ + Jim_Obj *errorCode = Jim_NewListObj(interp, NULL, 0); + + if (pid == JIM_BAD_PID || pid == JIM_NO_PID) { + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, "NONE", -1)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, (long)pid)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, -1)); + } + else if (WIFEXITED(waitStatus)) { + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, "CHILDSTATUS", -1)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, (long)pid)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, WEXITSTATUS(waitStatus))); + } + else { + const char *type; + const char *action; + const char *signame; + + if (WIFSIGNALED(waitStatus)) { + type = "CHILDKILLED"; + action = "killed"; + signame = Jim_SignalId(WTERMSIG(waitStatus)); + } + else { + type = "CHILDSUSP"; + action = "suspended"; + signame = "none"; + } + + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, type, -1)); + + if (errStrObj) { + Jim_AppendStrings(interp, errStrObj, "child ", action, " by signal ", Jim_SignalId(WTERMSIG(waitStatus)), "\n", NULL); + } + + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, (long)pid)); + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, signame, -1)); + } + return errorCode; +} + +static int JimCheckWaitStatus(Jim_Interp *interp, pidtype pid, int waitStatus, Jim_Obj *errStrObj) +{ + if (WIFEXITED(waitStatus) && WEXITSTATUS(waitStatus) == 0) { + return JIM_OK; + } + Jim_SetGlobalVariableStr(interp, "errorCode", JimMakeErrorCode(interp, pid, waitStatus, errStrObj)); + + return JIM_ERR; +} + + +struct WaitInfo +{ + pidtype pid; + int status; + int flags; +}; + + +struct WaitInfoTable { + struct WaitInfo *info; + int size; + int used; + int refcount; +}; + + +#define WI_DETACHED 2 + +#define WAIT_TABLE_GROW_BY 4 + +static void JimFreeWaitInfoTable(struct Jim_Interp *interp, void *privData) +{ + struct WaitInfoTable *table = privData; + + if (--table->refcount == 0) { + Jim_Free(table->info); + Jim_Free(table); + } +} + +static struct WaitInfoTable *JimAllocWaitInfoTable(void) +{ + struct WaitInfoTable *table = Jim_Alloc(sizeof(*table)); + table->info = NULL; + table->size = table->used = 0; + table->refcount = 1; + + return table; +} + +static int JimWaitRemove(struct WaitInfoTable *table, pidtype pid) +{ + int i; + + + for (i = 0; i < table->used; i++) { + if (pid == table->info[i].pid) { + if (i != table->used - 1) { + table->info[i] = table->info[table->used - 1]; + } + table->used--; + return 0; + } + } + return -1; +} + +static int Jim_ExecCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int outputId; + int errorId; + pidtype *pidPtr; + int numPids, result; + int child_siginfo = 1; + Jim_Obj *childErrObj; + Jim_Obj *errStrObj; + struct WaitInfoTable *table = Jim_CmdPrivData(interp); + + if (argc > 1 && Jim_CompareStringImmediate(interp, argv[argc - 1], "&")) { + Jim_Obj *listObj; + int i; + + argc--; + numPids = JimCreatePipeline(interp, argc - 1, argv + 1, &pidPtr, NULL, NULL, NULL); + if (numPids < 0) { + return JIM_ERR; + } + + listObj = Jim_NewListObj(interp, NULL, 0); + for (i = 0; i < numPids; i++) { + Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, (long)pidPtr[i])); + } + Jim_SetResult(interp, listObj); + JimDetachPids(table, numPids, pidPtr); + Jim_Free(pidPtr); + return JIM_OK; + } + + numPids = + JimCreatePipeline(interp, argc - 1, argv + 1, &pidPtr, NULL, &outputId, &errorId); + + if (numPids < 0) { + return JIM_ERR; + } + + result = JIM_OK; + + errStrObj = Jim_NewStringObj(interp, "", 0); + + + if (outputId != -1) { + if (JimAppendStreamToString(interp, outputId, errStrObj) < 0) { + result = JIM_ERR; + Jim_SetResultErrno(interp, "error reading from output pipe"); + } + } + + + childErrObj = Jim_NewStringObj(interp, "", 0); + Jim_IncrRefCount(childErrObj); + + if (JimCleanupChildren(interp, numPids, pidPtr, childErrObj) != JIM_OK) { + result = JIM_ERR; + } + + if (errorId != -1) { + int ret; + lseek(errorId, 0, SEEK_SET); + ret = JimAppendStreamToString(interp, errorId, errStrObj); + if (ret < 0) { + Jim_SetResultErrno(interp, "error reading from error pipe"); + result = JIM_ERR; + } + else if (ret > 0) { + + child_siginfo = 0; + } + } + + if (child_siginfo) { + + Jim_AppendObj(interp, errStrObj, childErrObj); + } + Jim_DecrRefCount(interp, childErrObj); + + + Jim_RemoveTrailingNewline(errStrObj); + + + Jim_SetResult(interp, errStrObj); + + return result; +} + +static pidtype JimWaitForProcess(struct WaitInfoTable *table, pidtype pid, int *statusPtr) +{ + if (JimWaitRemove(table, pid) == 0) { + + waitpid(pid, statusPtr, 0); + return pid; + } + + + return JIM_BAD_PID; +} + +static void JimDetachPids(struct WaitInfoTable *table, int numPids, const pidtype *pidPtr) +{ + int j; + + for (j = 0; j < numPids; j++) { + + int i; + for (i = 0; i < table->used; i++) { + if (pidPtr[j] == table->info[i].pid) { + table->info[i].flags |= WI_DETACHED; + break; + } + } + } +} + +static int JimGetChannelFd(Jim_Interp *interp, const char *name) +{ + Jim_Obj *objv[2]; + + objv[0] = Jim_NewStringObj(interp, name, -1); + objv[1] = Jim_NewStringObj(interp, "getfd", -1); + + if (Jim_EvalObjVector(interp, 2, objv) == JIM_OK) { + jim_wide fd; + if (Jim_GetWide(interp, Jim_GetResult(interp), &fd) == JIM_OK) { + return fd; + } + } + return -1; +} + +static void JimReapDetachedPids(struct WaitInfoTable *table) +{ + struct WaitInfo *waitPtr; + int count; + int dest; + + if (!table) { + return; + } + + waitPtr = table->info; + dest = 0; + for (count = table->used; count > 0; waitPtr++, count--) { + if (waitPtr->flags & WI_DETACHED) { + int status; + pidtype pid = waitpid(waitPtr->pid, &status, WNOHANG); + if (pid == waitPtr->pid) { + + table->used--; + continue; + } + } + if (waitPtr != &table->info[dest]) { + table->info[dest] = *waitPtr; + } + dest++; + } +} + +static int Jim_WaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct WaitInfoTable *table = Jim_CmdPrivData(interp); + int nohang = 0; + pidtype pid; + long pidarg; + int status; + Jim_Obj *errCodeObj; + + + if (argc == 1) { + JimReapDetachedPids(table); + return JIM_OK; + } + + if (argc > 1 && Jim_CompareStringImmediate(interp, argv[1], "-nohang")) { + nohang = 1; + } + if (argc != nohang + 2) { + Jim_WrongNumArgs(interp, 1, argv, "?-nohang? ?pid?"); + return JIM_ERR; + } + if (Jim_GetLong(interp, argv[nohang + 1], &pidarg) != JIM_OK) { + return JIM_ERR; + } + + pid = waitpid((pidtype)pidarg, &status, nohang ? WNOHANG : 0); + + errCodeObj = JimMakeErrorCode(interp, pid, status, NULL); + + if (pid != JIM_BAD_PID && (WIFEXITED(status) || WIFSIGNALED(status))) { + + JimWaitRemove(table, pid); + } + Jim_SetResult(interp, errCodeObj); + return JIM_OK; +} + +static int Jim_PidCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 1) { + Jim_WrongNumArgs(interp, 1, argv, ""); + return JIM_ERR; + } + + Jim_SetResultInt(interp, (jim_wide)getpid()); + return JIM_OK; +} + +static int +JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, pidtype **pidArrayPtr, + int *inPipePtr, int *outPipePtr, int *errFilePtr) +{ + pidtype *pidPtr = NULL; /* Points to malloc-ed array holding all + * the pids of child processes. */ + int numPids = 0; /* Actual number of processes that exist + * at *pidPtr right now. */ + int cmdCount; /* Count of number of distinct commands + * found in argc/argv. */ + const char *input = NULL; /* Describes input for pipeline, depending + * on "inputFile". NULL means take input + * from stdin/pipe. */ + int input_len = 0; + +#define FILE_NAME 0 +#define FILE_APPEND 1 +#define FILE_HANDLE 2 +#define FILE_TEXT 3 + + int inputFile = FILE_NAME; /* 1 means input is name of input file. + * 2 means input is filehandle name. + * 0 means input holds actual + * text to be input to command. */ + + int outputFile = FILE_NAME; /* 0 means output is the name of output file. + * 1 means output is the name of output file, and append. + * 2 means output is filehandle name. + * All this is ignored if output is NULL + */ + int errorFile = FILE_NAME; /* 0 means error is the name of error file. + * 1 means error is the name of error file, and append. + * 2 means error is filehandle name. + * All this is ignored if error is NULL + */ + const char *output = NULL; /* Holds name of output file to pipe to, + * or NULL if output goes to stdout/pipe. */ + const char *error = NULL; /* Holds name of stderr file to pipe to, + * or NULL if stderr goes to stderr/pipe. */ + int inputId = -1; + int outputId = -1; + int errorId = -1; + int lastOutputId = -1; + int pipeIds[2]; + int firstArg, lastArg; /* Indexes of first and last arguments in + * current command. */ + int lastBar; + int i; + pidtype pid; + char **save_environ; +#ifndef __MINGW32__ + char **child_environ; +#endif + struct WaitInfoTable *table = Jim_CmdPrivData(interp); + + + char **arg_array = Jim_Alloc(sizeof(*arg_array) * (argc + 1)); + int arg_count = 0; + + if (inPipePtr != NULL) { + *inPipePtr = -1; + } + if (outPipePtr != NULL) { + *outPipePtr = -1; + } + if (errFilePtr != NULL) { + *errFilePtr = -1; + } + pipeIds[0] = pipeIds[1] = -1; + + cmdCount = 1; + lastBar = -1; + for (i = 0; i < argc; i++) { + const char *arg = Jim_String(argv[i]); + + if (arg[0] == '<') { + inputFile = FILE_NAME; + input = arg + 1; + if (*input == '<') { + inputFile = FILE_TEXT; + input_len = Jim_Length(argv[i]) - 2; + input++; + } + else if (*input == '@') { + inputFile = FILE_HANDLE; + input++; + } + + if (!*input && ++i < argc) { + input = Jim_GetString(argv[i], &input_len); + } + } + else if (arg[0] == '>') { + int dup_error = 0; + + outputFile = FILE_NAME; + + output = arg + 1; + if (*output == '>') { + outputFile = FILE_APPEND; + output++; + } + if (*output == '&') { + + output++; + dup_error = 1; + } + if (*output == '@') { + outputFile = FILE_HANDLE; + output++; + } + if (!*output && ++i < argc) { + output = Jim_String(argv[i]); + } + if (dup_error) { + errorFile = outputFile; + error = output; + } + } + else if (arg[0] == '2' && arg[1] == '>') { + error = arg + 2; + errorFile = FILE_NAME; + + if (*error == '@') { + errorFile = FILE_HANDLE; + error++; + } + else if (*error == '>') { + errorFile = FILE_APPEND; + error++; + } + if (!*error && ++i < argc) { + error = Jim_String(argv[i]); + } + } + else { + if (strcmp(arg, "|") == 0 || strcmp(arg, "|&") == 0) { + if (i == lastBar + 1 || i == argc - 1) { + Jim_SetResultString(interp, "illegal use of | or |& in command", -1); + goto badargs; + } + lastBar = i; + cmdCount++; + } + + arg_array[arg_count++] = (char *)arg; + continue; + } + + if (i >= argc) { + Jim_SetResultFormatted(interp, "can't specify \"%s\" as last word in command", arg); + goto badargs; + } + } + + if (arg_count == 0) { + Jim_SetResultString(interp, "didn't specify command to execute", -1); +badargs: + Jim_Free(arg_array); + return -1; + } + + + save_environ = JimSaveEnv(JimBuildEnv(interp)); + + if (input != NULL) { + if (inputFile == FILE_TEXT) { + inputId = Jim_MakeTempFile(interp, NULL, 1); + if (inputId == -1) { + goto error; + } + if (write(inputId, input, input_len) != input_len) { + Jim_SetResultErrno(interp, "couldn't write temp file"); + close(inputId); + goto error; + } + lseek(inputId, 0L, SEEK_SET); + } + else if (inputFile == FILE_HANDLE) { + int fd = JimGetChannelFd(interp, input); + + if (fd < 0) { + goto error; + } + inputId = dup(fd); + } + else { + inputId = Jim_OpenForRead(input); + if (inputId == -1) { + Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", input, strerror(Jim_Errno())); + goto error; + } + } + } + else if (inPipePtr != NULL) { + if (pipe(pipeIds) != 0) { + Jim_SetResultErrno(interp, "couldn't create input pipe for command"); + goto error; + } + inputId = pipeIds[0]; + *inPipePtr = pipeIds[1]; + pipeIds[0] = pipeIds[1] = -1; + } + + if (output != NULL) { + if (outputFile == FILE_HANDLE) { + int fd = JimGetChannelFd(interp, output); + if (fd < 0) { + goto error; + } + lastOutputId = dup(fd); + } + else { + lastOutputId = Jim_OpenForWrite(output, outputFile == FILE_APPEND); + if (lastOutputId == -1) { + Jim_SetResultFormatted(interp, "couldn't write file \"%s\": %s", output, strerror(Jim_Errno())); + goto error; + } + } + } + else if (outPipePtr != NULL) { + if (pipe(pipeIds) != 0) { + Jim_SetResultErrno(interp, "couldn't create output pipe"); + goto error; + } + lastOutputId = pipeIds[1]; + *outPipePtr = pipeIds[0]; + pipeIds[0] = pipeIds[1] = -1; + } + + if (error != NULL) { + if (errorFile == FILE_HANDLE) { + if (strcmp(error, "1") == 0) { + + if (lastOutputId != -1) { + errorId = dup(lastOutputId); + } + else { + + error = "stdout"; + } + } + if (errorId == -1) { + int fd = JimGetChannelFd(interp, error); + if (fd < 0) { + goto error; + } + errorId = dup(fd); + } + } + else { + errorId = Jim_OpenForWrite(error, errorFile == FILE_APPEND); + if (errorId == -1) { + Jim_SetResultFormatted(interp, "couldn't write file \"%s\": %s", error, strerror(Jim_Errno())); + goto error; + } + } + } + else if (errFilePtr != NULL) { + errorId = Jim_MakeTempFile(interp, NULL, 1); + if (errorId == -1) { + goto error; + } + *errFilePtr = dup(errorId); + } + + + pidPtr = Jim_Alloc(cmdCount * sizeof(*pidPtr)); + for (i = 0; i < numPids; i++) { + pidPtr[i] = JIM_BAD_PID; + } + for (firstArg = 0; firstArg < arg_count; numPids++, firstArg = lastArg + 1) { + int pipe_dup_err = 0; + int origErrorId = errorId; + + for (lastArg = firstArg; lastArg < arg_count; lastArg++) { + if (strcmp(arg_array[lastArg], "|") == 0) { + break; + } + if (strcmp(arg_array[lastArg], "|&") == 0) { + pipe_dup_err = 1; + break; + } + } + + if (lastArg == firstArg) { + Jim_SetResultString(interp, "missing command to exec", -1); + goto error; + } + + + arg_array[lastArg] = NULL; + if (lastArg == arg_count) { + outputId = lastOutputId; + lastOutputId = -1; + } + else { + if (pipe(pipeIds) != 0) { + Jim_SetResultErrno(interp, "couldn't create pipe"); + goto error; + } + outputId = pipeIds[1]; + } + + + if (pipe_dup_err) { + errorId = outputId; + } + + + +#ifdef __MINGW32__ + pid = JimStartWinProcess(interp, &arg_array[firstArg], save_environ, inputId, outputId, errorId); + if (pid == JIM_BAD_PID) { + Jim_SetResultFormatted(interp, "couldn't exec \"%s\"", arg_array[firstArg]); + goto error; + } +#else + i = strlen(arg_array[firstArg]); + + child_environ = Jim_GetEnviron(); + pid = vfork(); + if (pid < 0) { + Jim_SetResultErrno(interp, "couldn't fork child process"); + goto error; + } + if (pid == 0) { + + + if (inputId != -1) { + dup2(inputId, fileno(stdin)); + close(inputId); + } + if (outputId != -1) { + dup2(outputId, fileno(stdout)); + if (outputId != errorId) { + close(outputId); + } + } + if (errorId != -1) { + dup2(errorId, fileno(stderr)); + close(errorId); + } + + if (outPipePtr) { + close(*outPipePtr); + } + if (errFilePtr) { + close(*errFilePtr); + } + if (pipeIds[0] != -1) { + close(pipeIds[0]); + } + if (lastOutputId != -1) { + close(lastOutputId); + } + + + (void)signal(SIGPIPE, SIG_DFL); + + execvpe(arg_array[firstArg], &arg_array[firstArg], child_environ); + + if (write(fileno(stderr), "couldn't exec \"", 15) && + write(fileno(stderr), arg_array[firstArg], i) && + write(fileno(stderr), "\"\n", 2)) { + + } +#ifdef JIM_MAINTAINER + { + + static char *const false_argv[2] = {"false", NULL}; + execvp(false_argv[0],false_argv); + } +#endif + _exit(127); + } +#endif + + + + if (table->used == table->size) { + table->size += WAIT_TABLE_GROW_BY; + table->info = Jim_Realloc(table->info, table->size * sizeof(*table->info)); + } + + table->info[table->used].pid = pid; + table->info[table->used].flags = 0; + table->used++; + + pidPtr[numPids] = pid; + + + errorId = origErrorId; + + + if (inputId != -1) { + close(inputId); + } + if (outputId != -1) { + close(outputId); + } + inputId = pipeIds[0]; + pipeIds[0] = pipeIds[1] = -1; + } + *pidArrayPtr = pidPtr; + + + cleanup: + if (inputId != -1) { + close(inputId); + } + if (lastOutputId != -1) { + close(lastOutputId); + } + if (errorId != -1) { + close(errorId); + } + Jim_Free(arg_array); + + JimRestoreEnv(save_environ); + + return numPids; + + + error: + if ((inPipePtr != NULL) && (*inPipePtr != -1)) { + close(*inPipePtr); + *inPipePtr = -1; + } + if ((outPipePtr != NULL) && (*outPipePtr != -1)) { + close(*outPipePtr); + *outPipePtr = -1; + } + if ((errFilePtr != NULL) && (*errFilePtr != -1)) { + close(*errFilePtr); + *errFilePtr = -1; + } + if (pipeIds[0] != -1) { + close(pipeIds[0]); + } + if (pipeIds[1] != -1) { + close(pipeIds[1]); + } + if (pidPtr != NULL) { + for (i = 0; i < numPids; i++) { + if (pidPtr[i] != JIM_BAD_PID) { + JimDetachPids(table, 1, &pidPtr[i]); + } + } + Jim_Free(pidPtr); + } + numPids = -1; + goto cleanup; +} + + +static int JimCleanupChildren(Jim_Interp *interp, int numPids, pidtype *pidPtr, Jim_Obj *errStrObj) +{ + struct WaitInfoTable *table = Jim_CmdPrivData(interp); + int result = JIM_OK; + int i; + + + for (i = 0; i < numPids; i++) { + int waitStatus = 0; + if (JimWaitForProcess(table, pidPtr[i], &waitStatus) != JIM_BAD_PID) { + if (JimCheckWaitStatus(interp, pidPtr[i], waitStatus, errStrObj) != JIM_OK) { + result = JIM_ERR; + } + } + } + Jim_Free(pidPtr); + + return result; +} + +int Jim_execInit(Jim_Interp *interp) +{ + struct WaitInfoTable *waitinfo; + if (Jim_PackageProvide(interp, "exec", "1.0", JIM_ERRMSG)) + return JIM_ERR; + +#ifdef SIGPIPE + (void)signal(SIGPIPE, SIG_IGN); +#endif + + waitinfo = JimAllocWaitInfoTable(); + Jim_CreateCommand(interp, "exec", Jim_ExecCmd, waitinfo, JimFreeWaitInfoTable); + waitinfo->refcount++; + Jim_CreateCommand(interp, "wait", Jim_WaitCommand, waitinfo, JimFreeWaitInfoTable); + Jim_CreateCommand(interp, "pid", Jim_PidCommand, 0, 0); + + return JIM_OK; +} + +#if defined(__MINGW32__) + + +static int +JimWinFindExecutable(const char *originalName, char fullPath[MAX_PATH]) +{ + int i; + static char extensions[][5] = {".exe", "", ".bat"}; + + for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { + snprintf(fullPath, MAX_PATH, "%s%s", originalName, extensions[i]); + + if (SearchPath(NULL, fullPath, NULL, MAX_PATH, fullPath, NULL) == 0) { + continue; + } + if (GetFileAttributes(fullPath) & FILE_ATTRIBUTE_DIRECTORY) { + continue; + } + return 0; + } + + return -1; +} + +static char **JimSaveEnv(char **env) +{ + return env; +} + +static void JimRestoreEnv(char **env) +{ + JimFreeEnv(env, Jim_GetEnviron()); +} + +static char **JimOriginalEnviron(void) +{ + return NULL; +} + +static Jim_Obj * +JimWinBuildCommandLine(Jim_Interp *interp, char **argv) +{ + char *start, *special; + int quote, i; + + Jim_Obj *strObj = Jim_NewStringObj(interp, "", 0); + + for (i = 0; argv[i]; i++) { + if (i > 0) { + Jim_AppendString(interp, strObj, " ", 1); + } + + if (argv[i][0] == '\0') { + quote = 1; + } + else { + quote = 0; + for (start = argv[i]; *start != '\0'; start++) { + if (isspace(UCHAR(*start))) { + quote = 1; + break; + } + } + } + if (quote) { + Jim_AppendString(interp, strObj, "\"" , 1); + } + + start = argv[i]; + for (special = argv[i]; ; ) { + if ((*special == '\\') && (special[1] == '\\' || + special[1] == '"' || (quote && special[1] == '\0'))) { + Jim_AppendString(interp, strObj, start, special - start); + start = special; + while (1) { + special++; + if (*special == '"' || (quote && *special == '\0')) { + + Jim_AppendString(interp, strObj, start, special - start); + break; + } + if (*special != '\\') { + break; + } + } + Jim_AppendString(interp, strObj, start, special - start); + start = special; + } + if (*special == '"') { + if (special == start) { + Jim_AppendString(interp, strObj, "\"", 1); + } + else { + Jim_AppendString(interp, strObj, start, special - start); + } + Jim_AppendString(interp, strObj, "\\\"", 2); + start = special + 1; + } + if (*special == '\0') { + break; + } + special++; + } + Jim_AppendString(interp, strObj, start, special - start); + if (quote) { + Jim_AppendString(interp, strObj, "\"", 1); + } + } + return strObj; +} + +static pidtype +JimStartWinProcess(Jim_Interp *interp, char **argv, char **env, int inputId, int outputId, int errorId) +{ + STARTUPINFO startInfo; + PROCESS_INFORMATION procInfo; + HANDLE hProcess; + char execPath[MAX_PATH]; + pidtype pid = JIM_BAD_PID; + Jim_Obj *cmdLineObj; + char *winenv; + + if (JimWinFindExecutable(argv[0], execPath) < 0) { + return JIM_BAD_PID; + } + argv[0] = execPath; + + hProcess = GetCurrentProcess(); + cmdLineObj = JimWinBuildCommandLine(interp, argv); + + + ZeroMemory(&startInfo, sizeof(startInfo)); + startInfo.cb = sizeof(startInfo); + startInfo.dwFlags = STARTF_USESTDHANDLES; + startInfo.hStdInput = INVALID_HANDLE_VALUE; + startInfo.hStdOutput= INVALID_HANDLE_VALUE; + startInfo.hStdError = INVALID_HANDLE_VALUE; + + if (inputId == -1) { + inputId = _fileno(stdin); + } + DuplicateHandle(hProcess, (HANDLE)_get_osfhandle(inputId), hProcess, &startInfo.hStdInput, + 0, TRUE, DUPLICATE_SAME_ACCESS); + if (startInfo.hStdInput == INVALID_HANDLE_VALUE) { + goto end; + } + + if (outputId == -1) { + outputId = _fileno(stdout); + } + DuplicateHandle(hProcess, (HANDLE)_get_osfhandle(outputId), hProcess, &startInfo.hStdOutput, + 0, TRUE, DUPLICATE_SAME_ACCESS); + if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) { + goto end; + } + + + if (errorId == -1) { + errorId = _fileno(stderr); + } + DuplicateHandle(hProcess, (HANDLE)_get_osfhandle(errorId), hProcess, &startInfo.hStdError, + 0, TRUE, DUPLICATE_SAME_ACCESS); + if (startInfo.hStdError == INVALID_HANDLE_VALUE) { + goto end; + } + + if (env == NULL) { + + winenv = NULL; + } + else if (env[0] == NULL) { + winenv = (char *)"\0"; + } + else { + winenv = env[0]; + } + + if (!CreateProcess(NULL, (char *)Jim_String(cmdLineObj), NULL, NULL, TRUE, + 0, winenv, NULL, &startInfo, &procInfo)) { + goto end; + } + + + WaitForInputIdle(procInfo.hProcess, 5000); + CloseHandle(procInfo.hThread); + + pid = procInfo.hProcess; + + end: + Jim_FreeNewObj(interp, cmdLineObj); + if (startInfo.hStdInput != INVALID_HANDLE_VALUE) { + CloseHandle(startInfo.hStdInput); + } + if (startInfo.hStdOutput != INVALID_HANDLE_VALUE) { + CloseHandle(startInfo.hStdOutput); + } + if (startInfo.hStdError != INVALID_HANDLE_VALUE) { + CloseHandle(startInfo.hStdError); + } + return pid; +} + +#else + +static char **JimOriginalEnviron(void) +{ + return Jim_GetEnviron(); +} + +static char **JimSaveEnv(char **env) +{ + char **saveenv = Jim_GetEnviron(); + Jim_SetEnviron(env); + return saveenv; +} + +static void JimRestoreEnv(char **env) +{ + JimFreeEnv(Jim_GetEnviron(), env); + Jim_SetEnviron(env); +} +#endif +#endif + + + +#ifdef STRPTIME_NEEDS_XOPEN_SOURCE +#ifndef _XOPEN_SOURCE +#define _XOPEN_SOURCE 500 +#endif +#endif + + +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif + +#include +#include +#include +#include + + +#ifdef HAVE_SYS_TIME_H +#include +#endif + +struct clock_options { + int gmt; + const char *format; +}; + +static int parse_clock_options(Jim_Interp *interp, int argc, Jim_Obj *const *argv, struct clock_options *opts) +{ + static const char * const options[] = { "-gmt", "-format", NULL }; + enum { OPT_GMT, OPT_FORMAT, }; + int i; + + for (i = 0; i < argc; i += 2) { + int option; + if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_GMT: + if (Jim_GetBoolean(interp, argv[i + 1], &opts->gmt) != JIM_OK) { + return JIM_ERR; + } + break; + case OPT_FORMAT: + opts->format = Jim_String(argv[i + 1]); + break; + } + } + return JIM_OK; +} + +static int clock_cmd_format(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + + char buf[100]; + time_t t; + jim_wide seconds; + struct clock_options options = { 0, "%a %b %d %H:%M:%S %Z %Y" }; + struct tm *tm; + + if (Jim_GetWide(interp, argv[0], &seconds) != JIM_OK) { + return JIM_ERR; + } + if (argc % 2 == 0) { + return -1; + } + if (parse_clock_options(interp, argc - 1, argv + 1, &options) == JIM_ERR) { + return JIM_ERR; + } + + t = seconds; + tm = options.gmt ? gmtime(&t) : localtime(&t); + + if (tm == NULL || strftime(buf, sizeof(buf), options.format, tm) == 0) { + Jim_SetResultString(interp, "format string too long or invalid time", -1); + return JIM_ERR; + } + + Jim_SetResultString(interp, buf, -1); + + return JIM_OK; +} + +#ifdef HAVE_STRPTIME +static time_t jim_timegm(const struct tm *tm) +{ + int m = tm->tm_mon + 1; + int y = 1900 + tm->tm_year - (m <= 2); + int era = (y >= 0 ? y : y - 399) / 400; + unsigned yoe = (unsigned)(y - era * 400); + unsigned doy = (153 * (m + (m > 2 ? -3 : 9)) + 2) / 5 + tm->tm_mday - 1; + unsigned doe = yoe * 365 + yoe / 4 - yoe / 100 + doy; + long days = (era * 146097 + (int)doe - 719468); + int secs = tm->tm_hour * 3600 + tm->tm_min * 60 + tm->tm_sec; + + return days * 24 * 60 * 60 + secs; +} + +static int clock_cmd_scan(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + char *pt; + struct tm tm; + time_t now = time(NULL); + + struct clock_options options = { 0, NULL }; + + if (argc % 2 == 0) { + return -1; + } + + if (parse_clock_options(interp, argc - 1, argv + 1, &options) == JIM_ERR) { + return JIM_ERR; + } + if (options.format == NULL) { + return -1; + } + + localtime_r(&now, &tm); + + pt = strptime(Jim_String(argv[0]), options.format, &tm); + if (pt == 0 || *pt != 0) { + Jim_SetResultString(interp, "Failed to parse time according to format", -1); + return JIM_ERR; + } + + + Jim_SetResultInt(interp, options.gmt ? jim_timegm(&tm) : mktime(&tm)); + + return JIM_OK; +} +#endif + +static int clock_cmd_seconds(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_SetResultInt(interp, time(NULL)); + + return JIM_OK; +} + +static int clock_cmd_micros(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct timeval tv; + + gettimeofday(&tv, NULL); + + Jim_SetResultInt(interp, (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec); + + return JIM_OK; +} + +static int clock_cmd_millis(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct timeval tv; + + gettimeofday(&tv, NULL); + + Jim_SetResultInt(interp, (jim_wide) tv.tv_sec * 1000 + tv.tv_usec / 1000); + + return JIM_OK; +} + +static const jim_subcmd_type clock_command_table[] = { + { "clicks", + NULL, + clock_cmd_micros, + 0, + 0, + + }, + { "format", + "seconds ?-format string? ?-gmt boolean?", + clock_cmd_format, + 1, + 5, + + }, + { "microseconds", + NULL, + clock_cmd_micros, + 0, + 0, + + }, + { "milliseconds", + NULL, + clock_cmd_millis, + 0, + 0, + + }, +#ifdef HAVE_STRPTIME + { "scan", + "str -format format ?-gmt boolean?", + clock_cmd_scan, + 3, + 5, + + }, +#endif + { "seconds", + NULL, + clock_cmd_seconds, + 0, + 0, + + }, + { NULL } +}; + +int Jim_clockInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "clock", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "clock", Jim_SubCmdProc, (void *)clock_command_table, NULL); + return JIM_OK; +} + +#include +#include +#include +#include +#include + + +static int array_cmd_exists(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + + Jim_Obj *dictObj = Jim_GetVariable(interp, argv[0], JIM_UNSHARED); + Jim_SetResultInt(interp, dictObj && Jim_DictSize(interp, dictObj) != -1); + return JIM_OK; +} + +static int array_cmd_get(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + Jim_Obj *patternObj; + + if (!objPtr) { + return JIM_OK; + } + + patternObj = (argc == 1) ? NULL : argv[1]; + + + if (patternObj == NULL || Jim_CompareStringImmediate(interp, patternObj, "*")) { + if (Jim_IsList(objPtr) && Jim_ListLength(interp, objPtr) % 2 == 0) { + + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + } + + return Jim_DictMatchTypes(interp, objPtr, patternObj, JIM_DICTMATCH_KEYS, JIM_DICTMATCH_KEYS | JIM_DICTMATCH_VALUES); +} + +static int array_cmd_names(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + + if (!objPtr) { + return JIM_OK; + } + + return Jim_DictMatchTypes(interp, objPtr, argc == 1 ? NULL : argv[1], JIM_DICTMATCH_KEYS, JIM_DICTMATCH_KEYS); +} + +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 **dictValuesObj; + + if (argc == 1 || Jim_CompareStringImmediate(interp, argv[1], "*")) { + + Jim_UnsetVariable(interp, argv[0], JIM_NONE); + return JIM_OK; + } + + objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + + if (objPtr == NULL) { + + return JIM_OK; + } + + if (Jim_DictPairs(interp, objPtr, &dictValuesObj, &len) != JIM_OK) { + + Jim_SetResultString(interp, "", -1); + return JIM_OK; + } + + + resultObj = Jim_NewDictObj(interp, NULL, 0); + + for (i = 0; i < len; i += 2) { + if (!Jim_StringMatchObj(interp, 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; + + + objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + if (objPtr) { + len = Jim_DictSize(interp, objPtr); + if (len < 0) { + + Jim_SetResultInt(interp, 0); + return JIM_OK; + } + } + + Jim_SetResultInt(interp, len); + + return JIM_OK; +} + +static int array_cmd_stat(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + if (objPtr) { + return Jim_DictInfo(interp, objPtr); + } + Jim_SetResultFormatted(interp, "\"%#s\" isn't an array", argv[0], NULL); + return JIM_ERR; +} + +static int array_cmd_set(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + int len; + Jim_Obj *listObj = argv[1]; + Jim_Obj *dictObj; + + len = Jim_ListLength(interp, listObj); + if (len % 2) { + Jim_SetResultString(interp, "list must have an even number of elements", -1); + return JIM_ERR; + } + + dictObj = Jim_GetVariable(interp, argv[0], JIM_UNSHARED); + if (!dictObj) { + + return Jim_SetVariable(interp, argv[0], listObj); + } + else if (Jim_DictSize(interp, dictObj) < 0) { + return JIM_ERR; + } + + if (Jim_IsShared(dictObj)) { + dictObj = Jim_DuplicateObj(interp, dictObj); + } + + 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_DictAddElement(interp, dictObj, nameObj, valueObj); + } + return Jim_SetVariable(interp, argv[0], dictObj); +} + +static const jim_subcmd_type array_command_table[] = { + { "exists", + "arrayName", + array_cmd_exists, + 1, + 1, + + }, + { "get", + "arrayName ?pattern?", + array_cmd_get, + 1, + 2, + + }, + { "names", + "arrayName ?pattern?", + array_cmd_names, + 1, + 2, + + }, + { "set", + "arrayName list", + array_cmd_set, + 2, + 2, + + }, + { "size", + "arrayName", + array_cmd_size, + 1, + 1, + + }, + { "stat", + "arrayName", + array_cmd_stat, + 1, + 1, + + }, + { "unset", + "arrayName ?pattern?", + array_cmd_unset, + 1, + 2, + + }, + { NULL + } +}; + +int Jim_arrayInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "array", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "array", Jim_SubCmdProc, (void *)array_command_table, NULL); + return JIM_OK; +} +int Jim_InitStaticExtensions(Jim_Interp *interp) +{ +extern int Jim_bootstrapInit(Jim_Interp *); +extern int Jim_aioInit(Jim_Interp *); +extern int Jim_readdirInit(Jim_Interp *); +extern int Jim_regexpInit(Jim_Interp *); +extern int Jim_fileInit(Jim_Interp *); +extern int Jim_globInit(Jim_Interp *); +extern int Jim_execInit(Jim_Interp *); +extern int Jim_clockInit(Jim_Interp *); +extern int Jim_arrayInit(Jim_Interp *); +extern int Jim_stdlibInit(Jim_Interp *); +extern int Jim_tclcompatInit(Jim_Interp *); +Jim_bootstrapInit(interp); +Jim_aioInit(interp); +Jim_readdirInit(interp); +Jim_regexpInit(interp); +Jim_fileInit(interp); +Jim_globInit(interp); +Jim_execInit(interp); +Jim_clockInit(interp); +Jim_arrayInit(interp); +Jim_stdlibInit(interp); +Jim_tclcompatInit(interp); +return JIM_OK; +} +#define JIM_OPTIMIZATION +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif + +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include + + +#ifdef HAVE_SYS_TIME_H +#include +#endif +#ifdef HAVE_BACKTRACE +#include +#endif +#ifdef HAVE_CRT_EXTERNS_H +#include +#endif + + +#include + + + + + +#ifndef TCL_LIBRARY +#define TCL_LIBRARY "." +#endif +#ifndef TCL_PLATFORM_OS +#define TCL_PLATFORM_OS "unknown" +#endif +#ifndef TCL_PLATFORM_PLATFORM +#define TCL_PLATFORM_PLATFORM "unknown" +#endif +#ifndef TCL_PLATFORM_PATH_SEPARATOR +#define TCL_PLATFORM_PATH_SEPARATOR ":" +#endif + + + + + + + +#ifdef JIM_MAINTAINER +#define JIM_DEBUG_COMMAND +#define JIM_DEBUG_PANIC +#endif + + + +#define JIM_INTEGER_SPACE 24 + +const char *jim_tt_name(int type); + +#ifdef JIM_DEBUG_PANIC +static void JimPanicDump(int fail_condition, const char *fmt, ...); +#define JimPanic(X) JimPanicDump X +#else +#define JimPanic(X) +#endif + +#ifdef JIM_OPTIMIZATION +#define JIM_IF_OPTIM(X) X +#else +#define JIM_IF_OPTIM(X) +#endif + + +static char JimEmptyStringRep[] = ""; + +static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action); +static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr, + int flags); +static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands); +static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr); +static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr); +static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len); +static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype, + const char *prefix, const char *const *tablePtr, const char *name); +static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv); +static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr); +static int JimSign(jim_wide w); +static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr); +static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen); +static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len); + + + +#define JimWideValue(objPtr) (objPtr)->internalRep.wideValue + +#define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none") + +static int utf8_tounicode_case(const char *s, int *uc, int upper) +{ + int l = utf8_tounicode(s, uc); + if (upper) { + *uc = utf8_upper(*uc); + } + return l; +} + + +#define JIM_CHARSET_SCAN 2 +#define JIM_CHARSET_GLOB 0 + +static const char *JimCharsetMatch(const char *pattern, int c, int flags) +{ + int not = 0; + int pchar; + int match = 0; + int nocase = 0; + + if (flags & JIM_NOCASE) { + nocase++; + c = utf8_upper(c); + } + + if (flags & JIM_CHARSET_SCAN) { + if (*pattern == '^') { + not++; + pattern++; + } + + + if (*pattern == ']') { + goto first; + } + } + + while (*pattern && *pattern != ']') { + + if (pattern[0] == '\\') { +first: + pattern += utf8_tounicode_case(pattern, &pchar, nocase); + } + else { + + int start; + int end; + + pattern += utf8_tounicode_case(pattern, &start, nocase); + if (pattern[0] == '-' && pattern[1]) { + + pattern++; + pattern += utf8_tounicode_case(pattern, &end, nocase); + + + if ((c >= start && c <= end) || (c >= end && c <= start)) { + match = 1; + } + continue; + } + pchar = start; + } + + if (pchar == c) { + match = 1; + } + } + if (not) { + match = !match; + } + + return match ? pattern : NULL; +} + + + +static int JimGlobMatch(const char *pattern, const char *string, int nocase) +{ + int c; + int pchar; + while (*pattern) { + switch (pattern[0]) { + case '*': + while (pattern[1] == '*') { + pattern++; + } + pattern++; + if (!pattern[0]) { + return 1; + } + while (*string) { + + if (JimGlobMatch(pattern, string, nocase)) + return 1; + string += utf8_tounicode(string, &c); + } + return 0; + + case '?': + string += utf8_tounicode(string, &c); + break; + + case '[': { + string += utf8_tounicode(string, &c); + pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0); + if (!pattern) { + return 0; + } + if (!*pattern) { + + continue; + } + break; + } + case '\\': + if (pattern[1]) { + pattern++; + } + + default: + string += utf8_tounicode_case(string, &c, nocase); + utf8_tounicode_case(pattern, &pchar, nocase); + if (pchar != c) { + return 0; + } + break; + } + pattern += utf8_tounicode_case(pattern, &pchar, nocase); + if (!*string) { + while (*pattern == '*') { + pattern++; + } + break; + } + } + if (!*pattern && !*string) { + return 1; + } + return 0; +} + +static int JimStringCompare(const char *s1, int l1, const char *s2, int l2) +{ + if (l1 < l2) { + return memcmp(s1, s2, l1) <= 0 ? -1 : 1; + } + else if (l2 < l1) { + return memcmp(s1, s2, l2) >= 0 ? 1 : -1; + } + else { + return JimSign(memcmp(s1, s2, l1)); + } +} + +static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase) +{ + while (*s1 && *s2 && maxchars) { + int c1, c2; + s1 += utf8_tounicode_case(s1, &c1, nocase); + s2 += utf8_tounicode_case(s2, &c2, nocase); + if (c1 != c2) { + return JimSign(c1 - c2); + } + maxchars--; + } + if (!maxchars) { + return 0; + } + + if (*s1) { + return 1; + } + if (*s2) { + return -1; + } + return 0; +} + +static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx) +{ + int i; + int l1bytelen; + + if (!l1 || !l2 || l1 > l2) { + return -1; + } + if (idx < 0) + idx = 0; + s2 += utf8_index(s2, idx); + + l1bytelen = utf8_index(s1, l1); + + for (i = idx; i <= l2 - l1; i++) { + int c; + if (memcmp(s2, s1, l1bytelen) == 0) { + return i; + } + s2 += utf8_tounicode(s2, &c); + } + return -1; +} + +static int JimStringLast(const char *s1, int l1, const char *s2, int l2) +{ + const char *p; + + if (!l1 || !l2 || l1 > l2) + return -1; + + + for (p = s2 + l2 - 1; p != s2 - 1; p--) { + if (*p == *s1 && memcmp(s1, p, l1) == 0) { + return p - s2; + } + } + return -1; +} + +#ifdef JIM_UTF8 +static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2) +{ + int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2)); + if (n > 0) { + n = utf8_strlen(s2, n); + } + return n; +} +#endif + +static int JimCheckConversion(const char *str, const char *endptr) +{ + if (str[0] == '\0' || str == endptr) { + return JIM_ERR; + } + + if (endptr[0] != '\0') { + while (*endptr) { + if (!isspace(UCHAR(*endptr))) { + return JIM_ERR; + } + endptr++; + } + } + return JIM_OK; +} + +static int JimNumberBase(const char *str, int *base, int *sign) +{ + int i = 0; + + *base = 10; + + while (isspace(UCHAR(str[i]))) { + i++; + } + + if (str[i] == '-') { + *sign = -1; + i++; + } + else { + if (str[i] == '+') { + i++; + } + *sign = 1; + } + + if (str[i] != '0') { + + return 0; + } + + + switch (str[i + 1]) { + case 'x': case 'X': *base = 16; break; + case 'o': case 'O': *base = 8; break; + case 'b': case 'B': *base = 2; break; + default: return 0; + } + i += 2; + + if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) { + + return i; + } + + *base = 10; + return 0; +} + +static long jim_strtol(const char *str, char **endptr) +{ + int sign; + int base; + int i = JimNumberBase(str, &base, &sign); + + if (base != 10) { + long value = strtol(str + i, endptr, base); + if (endptr == NULL || *endptr != str + i) { + return value * sign; + } + } + + + return strtol(str, endptr, 10); +} + + +static jim_wide jim_strtoull(const char *str, char **endptr) +{ +#ifdef HAVE_LONG_LONG + int sign; + int base; + int i = JimNumberBase(str, &base, &sign); + + if (base != 10) { + jim_wide value = strtoull(str + i, endptr, base); + if (endptr == NULL || *endptr != str + i) { + return value * sign; + } + } + + + return strtoull(str, endptr, 10); +#else + return (unsigned long)jim_strtol(str, endptr); +#endif +} + +int Jim_StringToWide(const char *str, jim_wide * widePtr, int base) +{ + char *endptr; + + if (base) { + *widePtr = strtoull(str, &endptr, base); + } + else { + *widePtr = jim_strtoull(str, &endptr); + } + + return JimCheckConversion(str, endptr); +} + +int Jim_StringToDouble(const char *str, double *doublePtr) +{ + char *endptr; + + + errno = 0; + + *doublePtr = strtod(str, &endptr); + + return JimCheckConversion(str, endptr); +} + +static jim_wide JimPowWide(jim_wide b, jim_wide e) +{ + jim_wide res = 1; + + + if (b == 1) { + + return 1; + } + if (e < 0) { + if (b != -1) { + return 0; + } + e = -e; + } + while (e) + { + if (e & 1) { + res *= b; + } + e >>= 1; + b *= b; + } + return res; +} + +#ifdef JIM_DEBUG_PANIC +static void JimPanicDump(int condition, const char *fmt, ...) +{ + va_list ap; + + if (!condition) { + return; + } + + va_start(ap, fmt); + + fprintf(stderr, "\nJIM INTERPRETER PANIC: "); + vfprintf(stderr, fmt, ap); + fprintf(stderr, "\n\n"); + va_end(ap); + +#ifdef HAVE_BACKTRACE + { + void *array[40]; + int size, i; + char **strings; + + size = backtrace(array, 40); + strings = backtrace_symbols(array, size); + for (i = 0; i < size; i++) + fprintf(stderr, "[backtrace] %s\n", strings[i]); + fprintf(stderr, "[backtrace] Include the above lines and the output\n"); + fprintf(stderr, "[backtrace] of 'nm ' in the bug report.\n"); + } +#endif + + exit(1); +} +#endif + + +void *Jim_Alloc(int size) +{ + return size ? malloc(size) : NULL; +} + +void Jim_Free(void *ptr) +{ + free(ptr); +} + +void *Jim_Realloc(void *ptr, int size) +{ + return realloc(ptr, size); +} + +char *Jim_StrDup(const char *s) +{ + return strdup(s); +} + +char *Jim_StrDupLen(const char *s, int l) +{ + char *copy = Jim_Alloc(l + 1); + + memcpy(copy, s, l + 1); + copy[l] = 0; + return copy; +} + + + +static jim_wide JimClock(void) +{ + struct timeval tv; + + gettimeofday(&tv, NULL); + return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec; +} + + + +static void JimExpandHashTableIfNeeded(Jim_HashTable *ht); +static unsigned int JimHashTableNextPower(unsigned int size); +static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace); + + + + +unsigned int Jim_IntHashFunction(unsigned int key) +{ + key += ~(key << 15); + key ^= (key >> 10); + key += (key << 3); + key ^= (key >> 6); + key += ~(key << 11); + key ^= (key >> 16); + return key; +} + +unsigned int Jim_GenHashFunction(const unsigned char *buf, int len) +{ + unsigned int h = 0; + + while (len--) + h += (h << 3) + *buf++; + return h; +} + + + + +static void JimResetHashTable(Jim_HashTable *ht) +{ + ht->table = NULL; + ht->size = 0; + ht->sizemask = 0; + ht->used = 0; + ht->collisions = 0; +#ifdef JIM_RANDOMISE_HASH + ht->uniq = (rand() ^ time(NULL) ^ clock()); +#else + ht->uniq = 0; +#endif +} + +static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter) +{ + iter->ht = ht; + iter->index = -1; + iter->entry = NULL; + iter->nextEntry = NULL; +} + + +int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr) +{ + JimResetHashTable(ht); + ht->type = type; + ht->privdata = privDataPtr; + return JIM_OK; +} + +void Jim_ResizeHashTable(Jim_HashTable *ht) +{ + int minimal = ht->used; + + if (minimal < JIM_HT_INITIAL_SIZE) + minimal = JIM_HT_INITIAL_SIZE; + Jim_ExpandHashTable(ht, minimal); +} + + +void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size) +{ + Jim_HashTable n; + unsigned int realsize = JimHashTableNextPower(size), i; + + if (size <= ht->used) + return; + + Jim_InitHashTable(&n, ht->type, ht->privdata); + n.size = realsize; + n.sizemask = realsize - 1; + n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *)); + + n.uniq = ht->uniq; + + + memset(n.table, 0, realsize * sizeof(Jim_HashEntry *)); + + n.used = ht->used; + for (i = 0; ht->used > 0; i++) { + Jim_HashEntry *he, *nextHe; + + if (ht->table[i] == NULL) + continue; + + + he = ht->table[i]; + while (he) { + unsigned int h; + + nextHe = he->next; + + h = Jim_HashKey(ht, he->key) & n.sizemask; + he->next = n.table[h]; + n.table[h] = he; + ht->used--; + + he = nextHe; + } + } + assert(ht->used == 0); + Jim_Free(ht->table); + + + *ht = n; +} + + +int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val) +{ + Jim_HashEntry *entry; + + entry = JimInsertHashEntry(ht, key, 0); + if (entry == NULL) + return JIM_ERR; + + + Jim_SetHashKey(ht, entry, key); + Jim_SetHashVal(ht, entry, val); + return JIM_OK; +} + + +int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val) +{ + int existed; + Jim_HashEntry *entry; + + entry = JimInsertHashEntry(ht, key, 1); + if (entry->key) { + if (ht->type->valDestructor && ht->type->valDup) { + void *newval = ht->type->valDup(ht->privdata, val); + ht->type->valDestructor(ht->privdata, entry->u.val); + entry->u.val = newval; + } + else { + Jim_FreeEntryVal(ht, entry); + Jim_SetHashVal(ht, entry, val); + } + existed = 1; + } + else { + + Jim_SetHashKey(ht, entry, key); + Jim_SetHashVal(ht, entry, val); + existed = 0; + } + + return existed; +} + + +int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key) +{ + unsigned int h; + Jim_HashEntry *he, *prevHe; + + if (ht->used == 0) + return JIM_ERR; + h = Jim_HashKey(ht, key) & ht->sizemask; + he = ht->table[h]; + + prevHe = NULL; + while (he) { + if (Jim_CompareHashKeys(ht, key, he->key)) { + + if (prevHe) + prevHe->next = he->next; + else + ht->table[h] = he->next; + Jim_FreeEntryKey(ht, he); + Jim_FreeEntryVal(ht, he); + Jim_Free(he); + ht->used--; + return JIM_OK; + } + prevHe = he; + he = he->next; + } + return JIM_ERR; +} + + +int Jim_FreeHashTable(Jim_HashTable *ht) +{ + unsigned int i; + + + for (i = 0; ht->used > 0; i++) { + Jim_HashEntry *he, *nextHe; + + if ((he = ht->table[i]) == NULL) + continue; + while (he) { + nextHe = he->next; + Jim_FreeEntryKey(ht, he); + Jim_FreeEntryVal(ht, he); + Jim_Free(he); + ht->used--; + he = nextHe; + } + } + + Jim_Free(ht->table); + + JimResetHashTable(ht); + return JIM_OK; +} + +Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key) +{ + Jim_HashEntry *he; + unsigned int h; + + if (ht->used == 0) + return NULL; + h = Jim_HashKey(ht, key) & ht->sizemask; + he = ht->table[h]; + while (he) { + if (Jim_CompareHashKeys(ht, key, he->key)) + return he; + he = he->next; + } + return NULL; +} + +Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht) +{ + Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter)); + JimInitHashTableIterator(ht, iter); + return iter; +} + +Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter) +{ + while (1) { + if (iter->entry == NULL) { + iter->index++; + if (iter->index >= (signed)iter->ht->size) + break; + iter->entry = iter->ht->table[iter->index]; + } + else { + iter->entry = iter->nextEntry; + } + if (iter->entry) { + iter->nextEntry = iter->entry->next; + return iter->entry; + } + } + return NULL; +} + + + + +static void JimExpandHashTableIfNeeded(Jim_HashTable *ht) +{ + if (ht->size == 0) + Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE); + if (ht->size == ht->used) + Jim_ExpandHashTable(ht, ht->size * 2); +} + + +static unsigned int JimHashTableNextPower(unsigned int size) +{ + unsigned int i = JIM_HT_INITIAL_SIZE; + + if (size >= 2147483648U) + return 2147483648U; + while (1) { + if (i >= size) + return i; + i *= 2; + } +} + +static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace) +{ + unsigned int h; + Jim_HashEntry *he; + + + JimExpandHashTableIfNeeded(ht); + + + h = Jim_HashKey(ht, key) & ht->sizemask; + + he = ht->table[h]; + while (he) { + if (Jim_CompareHashKeys(ht, key, he->key)) + return replace ? he : NULL; + he = he->next; + } + + + he = Jim_Alloc(sizeof(*he)); + he->next = ht->table[h]; + ht->table[h] = he; + ht->used++; + he->key = NULL; + + return he; +} + + + +static unsigned int JimStringCopyHTHashFunction(const void *key) +{ + return Jim_GenHashFunction(key, strlen(key)); +} + +static void *JimStringCopyHTDup(void *privdata, const void *key) +{ + return Jim_StrDup(key); +} + +static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2) +{ + return strcmp(key1, key2) == 0; +} + +static void JimStringCopyHTKeyDestructor(void *privdata, void *key) +{ + Jim_Free(key); +} + +static const Jim_HashTableType JimPackageHashTableType = { + JimStringCopyHTHashFunction, + JimStringCopyHTDup, + NULL, + JimStringCopyHTKeyCompare, + JimStringCopyHTKeyDestructor, + NULL +}; + +typedef struct AssocDataValue +{ + Jim_InterpDeleteProc *delProc; + void *data; +} AssocDataValue; + +static void JimAssocDataHashTableValueDestructor(void *privdata, void *data) +{ + AssocDataValue *assocPtr = (AssocDataValue *) data; + + if (assocPtr->delProc != NULL) + assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data); + Jim_Free(data); +} + +static const Jim_HashTableType JimAssocDataHashTableType = { + JimStringCopyHTHashFunction, + JimStringCopyHTDup, + NULL, + JimStringCopyHTKeyCompare, + JimStringCopyHTKeyDestructor, + JimAssocDataHashTableValueDestructor +}; + +void Jim_InitStack(Jim_Stack *stack) +{ + stack->len = 0; + stack->maxlen = 0; + stack->vector = NULL; +} + +void Jim_FreeStack(Jim_Stack *stack) +{ + Jim_Free(stack->vector); +} + +int Jim_StackLen(Jim_Stack *stack) +{ + return stack->len; +} + +void Jim_StackPush(Jim_Stack *stack, void *element) +{ + int neededLen = stack->len + 1; + + if (neededLen > stack->maxlen) { + stack->maxlen = neededLen < 20 ? 20 : neededLen * 2; + stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen); + } + stack->vector[stack->len] = element; + stack->len++; +} + +void *Jim_StackPop(Jim_Stack *stack) +{ + if (stack->len == 0) + return NULL; + stack->len--; + return stack->vector[stack->len]; +} + +void *Jim_StackPeek(Jim_Stack *stack) +{ + if (stack->len == 0) + return NULL; + return stack->vector[stack->len - 1]; +} + +void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr)) +{ + int i; + + for (i = 0; i < stack->len; i++) + freeFunc(stack->vector[i]); +} + + + +#define JIM_TT_NONE 0 +#define JIM_TT_STR 1 +#define JIM_TT_ESC 2 +#define JIM_TT_VAR 3 +#define JIM_TT_DICTSUGAR 4 +#define JIM_TT_CMD 5 + +#define JIM_TT_SEP 6 +#define JIM_TT_EOL 7 +#define JIM_TT_EOF 8 + +#define JIM_TT_LINE 9 +#define JIM_TT_WORD 10 + + +#define JIM_TT_SUBEXPR_START 11 +#define JIM_TT_SUBEXPR_END 12 +#define JIM_TT_SUBEXPR_COMMA 13 +#define JIM_TT_EXPR_INT 14 +#define JIM_TT_EXPR_DOUBLE 15 +#define JIM_TT_EXPR_BOOLEAN 16 + +#define JIM_TT_EXPRSUGAR 17 + + +#define JIM_TT_EXPR_OP 20 + +#define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF) + +#define TOKEN_IS_EXPR_START(type) (type == JIM_TT_NONE || type == JIM_TT_SUBEXPR_START || type == JIM_TT_SUBEXPR_COMMA) + +#define TOKEN_IS_EXPR_OP(type) (type >= JIM_TT_EXPR_OP) + +struct JimParseMissing { + int ch; + int line; +}; + +struct JimParserCtx +{ + const char *p; + int len; + int linenr; + const char *tstart; + const char *tend; + int tline; + int tt; + int eof; + int inquote; + int comment; + struct JimParseMissing missing; +}; + +static int JimParseScript(struct JimParserCtx *pc); +static int JimParseSep(struct JimParserCtx *pc); +static int JimParseEol(struct JimParserCtx *pc); +static int JimParseCmd(struct JimParserCtx *pc); +static int JimParseQuote(struct JimParserCtx *pc); +static int JimParseVar(struct JimParserCtx *pc); +static int JimParseBrace(struct JimParserCtx *pc); +static int JimParseStr(struct JimParserCtx *pc); +static int JimParseComment(struct JimParserCtx *pc); +static void JimParseSubCmd(struct JimParserCtx *pc); +static int JimParseSubQuote(struct JimParserCtx *pc); +static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc); + +static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr) +{ + pc->p = prg; + pc->len = len; + pc->tstart = NULL; + pc->tend = NULL; + pc->tline = 0; + pc->tt = JIM_TT_NONE; + pc->eof = 0; + pc->inquote = 0; + pc->linenr = linenr; + pc->comment = 1; + pc->missing.ch = ' '; + pc->missing.line = linenr; +} + +static int JimParseScript(struct JimParserCtx *pc) +{ + while (1) { + if (!pc->len) { + pc->tstart = pc->p; + pc->tend = pc->p - 1; + pc->tline = pc->linenr; + pc->tt = JIM_TT_EOL; + pc->eof = 1; + return JIM_OK; + } + switch (*(pc->p)) { + case '\\': + if (*(pc->p + 1) == '\n' && !pc->inquote) { + return JimParseSep(pc); + } + pc->comment = 0; + return JimParseStr(pc); + case ' ': + case '\t': + case '\r': + case '\f': + if (!pc->inquote) + return JimParseSep(pc); + pc->comment = 0; + return JimParseStr(pc); + case '\n': + case ';': + pc->comment = 1; + if (!pc->inquote) + return JimParseEol(pc); + return JimParseStr(pc); + case '[': + pc->comment = 0; + return JimParseCmd(pc); + case '$': + pc->comment = 0; + if (JimParseVar(pc) == JIM_ERR) { + + pc->tstart = pc->tend = pc->p++; + pc->len--; + pc->tt = JIM_TT_ESC; + } + return JIM_OK; + case '#': + if (pc->comment) { + JimParseComment(pc); + continue; + } + return JimParseStr(pc); + default: + pc->comment = 0; + return JimParseStr(pc); + } + return JIM_OK; + } +} + +static int JimParseSep(struct JimParserCtx *pc) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) { + if (*pc->p == '\n') { + break; + } + if (*pc->p == '\\') { + pc->p++; + pc->len--; + pc->linenr++; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_SEP; + return JIM_OK; +} + +static int JimParseEol(struct JimParserCtx *pc) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + while (isspace(UCHAR(*pc->p)) || *pc->p == ';') { + if (*pc->p == '\n') + pc->linenr++; + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_EOL; + return JIM_OK; +} + + +static void JimParseSubBrace(struct JimParserCtx *pc) +{ + int level = 1; + + + pc->p++; + pc->len--; + while (pc->len) { + switch (*pc->p) { + case '\\': + if (pc->len > 1) { + if (*++pc->p == '\n') { + pc->linenr++; + } + pc->len--; + } + break; + + case '{': + level++; + break; + + case '}': + if (--level == 0) { + pc->tend = pc->p - 1; + pc->p++; + pc->len--; + return; + } + break; + + case '\n': + pc->linenr++; + break; + } + pc->p++; + pc->len--; + } + pc->missing.ch = '{'; + pc->missing.line = pc->tline; + pc->tend = pc->p - 1; +} + +static int JimParseSubQuote(struct JimParserCtx *pc) +{ + int tt = JIM_TT_STR; + int line = pc->tline; + + + pc->p++; + pc->len--; + while (pc->len) { + switch (*pc->p) { + case '\\': + if (pc->len > 1) { + if (*++pc->p == '\n') { + pc->linenr++; + } + pc->len--; + tt = JIM_TT_ESC; + } + break; + + case '"': + pc->tend = pc->p - 1; + pc->p++; + pc->len--; + return tt; + + case '[': + JimParseSubCmd(pc); + tt = JIM_TT_ESC; + continue; + + case '\n': + pc->linenr++; + break; + + case '$': + tt = JIM_TT_ESC; + break; + } + pc->p++; + pc->len--; + } + pc->missing.ch = '"'; + pc->missing.line = line; + pc->tend = pc->p - 1; + return tt; +} + +static void JimParseSubCmd(struct JimParserCtx *pc) +{ + int level = 1; + int startofword = 1; + int line = pc->tline; + + + pc->p++; + pc->len--; + while (pc->len) { + switch (*pc->p) { + case '\\': + if (pc->len > 1) { + if (*++pc->p == '\n') { + pc->linenr++; + } + pc->len--; + } + break; + + case '[': + level++; + break; + + case ']': + if (--level == 0) { + pc->tend = pc->p - 1; + pc->p++; + pc->len--; + return; + } + break; + + case '"': + if (startofword) { + JimParseSubQuote(pc); + continue; + } + break; + + case '{': + JimParseSubBrace(pc); + startofword = 0; + continue; + + case '\n': + pc->linenr++; + break; + } + startofword = isspace(UCHAR(*pc->p)); + pc->p++; + pc->len--; + } + pc->missing.ch = '['; + pc->missing.line = line; + pc->tend = pc->p - 1; +} + +static int JimParseBrace(struct JimParserCtx *pc) +{ + pc->tstart = pc->p + 1; + pc->tline = pc->linenr; + pc->tt = JIM_TT_STR; + JimParseSubBrace(pc); + return JIM_OK; +} + +static int JimParseCmd(struct JimParserCtx *pc) +{ + pc->tstart = pc->p + 1; + pc->tline = pc->linenr; + pc->tt = JIM_TT_CMD; + JimParseSubCmd(pc); + return JIM_OK; +} + +static int JimParseQuote(struct JimParserCtx *pc) +{ + pc->tstart = pc->p + 1; + pc->tline = pc->linenr; + pc->tt = JimParseSubQuote(pc); + return JIM_OK; +} + +static int JimParseVar(struct JimParserCtx *pc) +{ + + pc->p++; + pc->len--; + +#ifdef EXPRSUGAR_BRACKET + if (*pc->p == '[') { + + JimParseCmd(pc); + pc->tt = JIM_TT_EXPRSUGAR; + return JIM_OK; + } +#endif + + pc->tstart = pc->p; + pc->tt = JIM_TT_VAR; + pc->tline = pc->linenr; + + if (*pc->p == '{') { + pc->tstart = ++pc->p; + pc->len--; + + while (pc->len && *pc->p != '}') { + if (*pc->p == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + if (pc->len) { + pc->p++; + pc->len--; + } + } + else { + while (1) { + + if (pc->p[0] == ':' && pc->p[1] == ':') { + while (*pc->p == ':') { + pc->p++; + pc->len--; + } + continue; + } + if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) { + pc->p++; + pc->len--; + continue; + } + break; + } + + if (*pc->p == '(') { + int count = 1; + const char *paren = NULL; + + pc->tt = JIM_TT_DICTSUGAR; + + while (count && pc->len) { + pc->p++; + pc->len--; + if (*pc->p == '\\' && pc->len >= 1) { + pc->p++; + pc->len--; + } + else if (*pc->p == '(') { + count++; + } + else if (*pc->p == ')') { + paren = pc->p; + count--; + } + } + if (count == 0) { + pc->p++; + pc->len--; + } + else if (paren) { + + paren++; + pc->len += (pc->p - paren); + pc->p = paren; + } +#ifndef EXPRSUGAR_BRACKET + if (*pc->tstart == '(') { + pc->tt = JIM_TT_EXPRSUGAR; + } +#endif + } + pc->tend = pc->p - 1; + } + if (pc->tstart == pc->p) { + pc->p--; + pc->len++; + return JIM_ERR; + } + return JIM_OK; +} + +static int JimParseStr(struct JimParserCtx *pc) +{ + if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL || + pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) { + + if (*pc->p == '{') { + return JimParseBrace(pc); + } + if (*pc->p == '"') { + pc->inquote = 1; + pc->p++; + pc->len--; + + pc->missing.line = pc->tline; + } + } + pc->tstart = pc->p; + pc->tline = pc->linenr; + while (1) { + if (pc->len == 0) { + if (pc->inquote) { + pc->missing.ch = '"'; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + } + switch (*pc->p) { + case '\\': + if (!pc->inquote && *(pc->p + 1) == '\n') { + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + } + if (pc->len >= 2) { + if (*(pc->p + 1) == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; + } + else if (pc->len == 1) { + + pc->missing.ch = '\\'; + } + break; + case '(': + + if (pc->len > 1 && pc->p[1] != '$') { + break; + } + + case ')': + + if (*pc->p == '(' || pc->tt == JIM_TT_VAR) { + if (pc->p == pc->tstart) { + + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + } + break; + + case '$': + case '[': + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + case ' ': + case '\t': + case '\n': + case '\r': + case '\f': + case ';': + if (!pc->inquote) { + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + } + else if (*pc->p == '\n') { + pc->linenr++; + } + break; + case '"': + if (pc->inquote) { + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + pc->p++; + pc->len--; + pc->inquote = 0; + return JIM_OK; + } + break; + } + pc->p++; + pc->len--; + } + return JIM_OK; +} + +static int JimParseComment(struct JimParserCtx *pc) +{ + while (*pc->p) { + if (*pc->p == '\\') { + pc->p++; + pc->len--; + if (pc->len == 0) { + pc->missing.ch = '\\'; + return JIM_OK; + } + if (*pc->p == '\n') { + pc->linenr++; + } + } + else if (*pc->p == '\n') { + pc->p++; + pc->len--; + pc->linenr++; + break; + } + pc->p++; + pc->len--; + } + return JIM_OK; +} + + +static int xdigitval(int c) +{ + if (c >= '0' && c <= '9') + return c - '0'; + if (c >= 'a' && c <= 'f') + return c - 'a' + 10; + if (c >= 'A' && c <= 'F') + return c - 'A' + 10; + return -1; +} + +static int odigitval(int c) +{ + if (c >= '0' && c <= '7') + return c - '0'; + return -1; +} + +static int JimEscape(char *dest, const char *s, int slen) +{ + char *p = dest; + int i, len; + + for (i = 0; i < slen; i++) { + switch (s[i]) { + case '\\': + switch (s[i + 1]) { + case 'a': + *p++ = 0x7; + i++; + break; + case 'b': + *p++ = 0x8; + i++; + break; + case 'f': + *p++ = 0xc; + i++; + break; + case 'n': + *p++ = 0xa; + i++; + break; + case 'r': + *p++ = 0xd; + i++; + break; + case 't': + *p++ = 0x9; + i++; + break; + case 'u': + case 'U': + case 'x': + { + unsigned val = 0; + int k; + int maxchars = 2; + + i++; + + if (s[i] == 'U') { + maxchars = 8; + } + else if (s[i] == 'u') { + if (s[i + 1] == '{') { + maxchars = 6; + i++; + } + else { + maxchars = 4; + } + } + + for (k = 0; k < maxchars; k++) { + int c = xdigitval(s[i + k + 1]); + if (c == -1) { + break; + } + val = (val << 4) | c; + } + + if (s[i] == '{') { + if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') { + + i--; + k = 0; + } + else { + + k++; + } + } + if (k) { + + if (s[i] == 'x') { + *p++ = val; + } + else { + p += utf8_fromunicode(p, val); + } + i += k; + break; + } + + *p++ = s[i]; + } + break; + case 'v': + *p++ = 0xb; + i++; + break; + case '\0': + *p++ = '\\'; + i++; + break; + case '\n': + + *p++ = ' '; + do { + i++; + } while (s[i + 1] == ' ' || s[i + 1] == '\t'); + break; + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + + { + int val = 0; + int c = odigitval(s[i + 1]); + + val = c; + c = odigitval(s[i + 2]); + if (c == -1) { + *p++ = val; + i++; + break; + } + val = (val * 8) + c; + c = odigitval(s[i + 3]); + if (c == -1) { + *p++ = val; + i += 2; + break; + } + val = (val * 8) + c; + *p++ = val; + i += 3; + } + break; + default: + *p++ = s[i + 1]; + i++; + break; + } + break; + default: + *p++ = s[i]; + break; + } + } + len = p - dest; + *p = '\0'; + return len; +} + +static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc) +{ + const char *start, *end; + char *token; + int len; + + start = pc->tstart; + end = pc->tend; + len = (end - start) + 1; + if (len < 0) { + len = 0; + } + token = Jim_Alloc(len + 1); + if (pc->tt != JIM_TT_ESC) { + + memcpy(token, start, len); + token[len] = '\0'; + } + else { + + len = JimEscape(token, start, len); + } + + return Jim_NewStringObjNoAlloc(interp, token, len); +} + +static int JimParseListSep(struct JimParserCtx *pc); +static int JimParseListStr(struct JimParserCtx *pc); +static int JimParseListQuote(struct JimParserCtx *pc); + +static int JimParseList(struct JimParserCtx *pc) +{ + if (isspace(UCHAR(*pc->p))) { + return JimParseListSep(pc); + } + switch (*pc->p) { + case '"': + return JimParseListQuote(pc); + + case '{': + return JimParseBrace(pc); + + default: + if (pc->len) { + return JimParseListStr(pc); + } + break; + } + + pc->tstart = pc->tend = pc->p; + pc->tline = pc->linenr; + pc->tt = JIM_TT_EOL; + pc->eof = 1; + return JIM_OK; +} + +static int JimParseListSep(struct JimParserCtx *pc) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + while (isspace(UCHAR(*pc->p))) { + if (*pc->p == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_SEP; + return JIM_OK; +} + +static int JimParseListQuote(struct JimParserCtx *pc) +{ + pc->p++; + pc->len--; + + pc->tstart = pc->p; + pc->tline = pc->linenr; + pc->tt = JIM_TT_STR; + + while (pc->len) { + switch (*pc->p) { + case '\\': + pc->tt = JIM_TT_ESC; + if (--pc->len == 0) { + + pc->tend = pc->p; + return JIM_OK; + } + pc->p++; + break; + case '\n': + pc->linenr++; + break; + case '"': + pc->tend = pc->p - 1; + pc->p++; + pc->len--; + return JIM_OK; + } + pc->p++; + pc->len--; + } + + pc->tend = pc->p - 1; + return JIM_OK; +} + +static int JimParseListStr(struct JimParserCtx *pc) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + pc->tt = JIM_TT_STR; + + while (pc->len) { + if (isspace(UCHAR(*pc->p))) { + pc->tend = pc->p - 1; + return JIM_OK; + } + if (*pc->p == '\\') { + if (--pc->len == 0) { + + pc->tend = pc->p; + return JIM_OK; + } + pc->tt = JIM_TT_ESC; + pc->p++; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + return JIM_OK; +} + + + +Jim_Obj *Jim_NewObj(Jim_Interp *interp) +{ + Jim_Obj *objPtr; + + + if (interp->freeList != NULL) { + + objPtr = interp->freeList; + interp->freeList = objPtr->nextObjPtr; + } + else { + + objPtr = Jim_Alloc(sizeof(*objPtr)); + } + + objPtr->refCount = 0; + + + objPtr->prevObjPtr = NULL; + objPtr->nextObjPtr = interp->liveList; + if (interp->liveList) + interp->liveList->prevObjPtr = objPtr; + interp->liveList = objPtr; + + return objPtr; +} + +void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr) +{ + + JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr, + objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "")); + + + Jim_FreeIntRep(interp, objPtr); + + if (objPtr->bytes != NULL) { + if (objPtr->bytes != JimEmptyStringRep) + Jim_Free(objPtr->bytes); + } + + if (objPtr->prevObjPtr) + objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr; + if (objPtr->nextObjPtr) + objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr; + if (interp->liveList == objPtr) + interp->liveList = objPtr->nextObjPtr; +#ifdef JIM_DISABLE_OBJECT_POOL + Jim_Free(objPtr); +#else + + objPtr->prevObjPtr = NULL; + objPtr->nextObjPtr = interp->freeList; + if (interp->freeList) + interp->freeList->prevObjPtr = objPtr; + interp->freeList = objPtr; + objPtr->refCount = -1; +#endif +} + + +void Jim_InvalidateStringRep(Jim_Obj *objPtr) +{ + if (objPtr->bytes != NULL) { + if (objPtr->bytes != JimEmptyStringRep) + Jim_Free(objPtr->bytes); + } + objPtr->bytes = NULL; +} + + +Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_Obj *dupPtr; + + dupPtr = Jim_NewObj(interp); + if (objPtr->bytes == NULL) { + + dupPtr->bytes = NULL; + } + else if (objPtr->length == 0) { + dupPtr->bytes = JimEmptyStringRep; + dupPtr->length = 0; + dupPtr->typePtr = NULL; + return dupPtr; + } + else { + dupPtr->bytes = Jim_Alloc(objPtr->length + 1); + dupPtr->length = objPtr->length; + + memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1); + } + + + dupPtr->typePtr = objPtr->typePtr; + if (objPtr->typePtr != NULL) { + if (objPtr->typePtr->dupIntRepProc == NULL) { + dupPtr->internalRep = objPtr->internalRep; + } + else { + + objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr); + } + } + return dupPtr; +} + +const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr) +{ + if (objPtr->bytes == NULL) { + + JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name)); + objPtr->typePtr->updateStringProc(objPtr); + } + if (lenPtr) + *lenPtr = objPtr->length; + return objPtr->bytes; +} + + +int Jim_Length(Jim_Obj *objPtr) +{ + if (objPtr->bytes == NULL) { + + Jim_GetString(objPtr, NULL); + } + return objPtr->length; +} + + +const char *Jim_String(Jim_Obj *objPtr) +{ + if (objPtr->bytes == NULL) { + + Jim_GetString(objPtr, NULL); + } + return objPtr->bytes; +} + +static void JimSetStringBytes(Jim_Obj *objPtr, const char *str) +{ + objPtr->bytes = Jim_StrDup(str); + objPtr->length = strlen(str); +} + +static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); + +static const Jim_ObjType dictSubstObjType = { + "dict-substitution", + FreeDictSubstInternalRep, + DupDictSubstInternalRep, + NULL, + JIM_TYPE_NONE, +}; + +static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); + +static const Jim_ObjType interpolatedObjType = { + "interpolated", + FreeInterpolatedInternalRep, + DupInterpolatedInternalRep, + NULL, + JIM_TYPE_NONE, +}; + +static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr); +} + +static void DupInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + + dupPtr->internalRep = srcPtr->internalRep; + + Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr); +} + +static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType stringObjType = { + "string", + NULL, + DupStringInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + +static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + JIM_NOTUSED(interp); + + dupPtr->internalRep.strValue.maxLength = srcPtr->length; + dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength; +} + +static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr->typePtr != &stringObjType) { + + if (objPtr->bytes == NULL) { + + JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name)); + objPtr->typePtr->updateStringProc(objPtr); + } + + Jim_FreeIntRep(interp, objPtr); + + objPtr->typePtr = &stringObjType; + objPtr->internalRep.strValue.maxLength = objPtr->length; + + objPtr->internalRep.strValue.charLength = -1; + } + return JIM_OK; +} + +int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr) +{ +#ifdef JIM_UTF8 + SetStringFromAny(interp, objPtr); + + if (objPtr->internalRep.strValue.charLength < 0) { + objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length); + } + return objPtr->internalRep.strValue.charLength; +#else + return Jim_Length(objPtr); +#endif +} + + +Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len) +{ + Jim_Obj *objPtr = Jim_NewObj(interp); + + + if (len == -1) + len = strlen(s); + + if (len == 0) { + objPtr->bytes = JimEmptyStringRep; + } + else { + objPtr->bytes = Jim_StrDupLen(s, len); + } + objPtr->length = len; + + + objPtr->typePtr = NULL; + return objPtr; +} + + +Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen) +{ +#ifdef JIM_UTF8 + + int bytelen = utf8_index(s, charlen); + + Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen); + + + objPtr->typePtr = &stringObjType; + objPtr->internalRep.strValue.maxLength = bytelen; + objPtr->internalRep.strValue.charLength = charlen; + + return objPtr; +#else + return Jim_NewStringObj(interp, s, charlen); +#endif +} + +Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len) +{ + Jim_Obj *objPtr = Jim_NewObj(interp); + + objPtr->bytes = s; + objPtr->length = (len == -1) ? strlen(s) : len; + objPtr->typePtr = NULL; + return objPtr; +} + +static void StringAppendString(Jim_Obj *objPtr, const char *str, int len) +{ + int needlen; + + if (len == -1) + len = strlen(str); + needlen = objPtr->length + len; + if (objPtr->internalRep.strValue.maxLength < needlen || + objPtr->internalRep.strValue.maxLength == 0) { + needlen *= 2; + + if (needlen < 7) { + needlen = 7; + } + if (objPtr->bytes == JimEmptyStringRep) { + objPtr->bytes = Jim_Alloc(needlen + 1); + } + else { + objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1); + } + objPtr->internalRep.strValue.maxLength = needlen; + } + memcpy(objPtr->bytes + objPtr->length, str, len); + objPtr->bytes[objPtr->length + len] = '\0'; + + if (objPtr->internalRep.strValue.charLength >= 0) { + + objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len); + } + objPtr->length += len; +} + +void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len) +{ + JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object")); + SetStringFromAny(interp, objPtr); + StringAppendString(objPtr, str, len); +} + +void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr) +{ + int len; + const char *str = Jim_GetString(appendObjPtr, &len); + Jim_AppendString(interp, objPtr, str, len); +} + +void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...) +{ + va_list ap; + + SetStringFromAny(interp, objPtr); + va_start(ap, objPtr); + while (1) { + const char *s = va_arg(ap, const char *); + + if (s == NULL) + break; + Jim_AppendString(interp, objPtr, s, -1); + } + va_end(ap); +} + +int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr) +{ + if (aObjPtr == bObjPtr) { + return 1; + } + else { + int Alen, Blen; + const char *sA = Jim_GetString(aObjPtr, &Alen); + const char *sB = Jim_GetString(bObjPtr, &Blen); + + return Alen == Blen && memcmp(sA, sB, Alen) == 0; + } +} + +int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase) +{ + return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase); +} + +int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase) +{ + int l1, l2; + const char *s1 = Jim_GetString(firstObjPtr, &l1); + const char *s2 = Jim_GetString(secondObjPtr, &l2); + + if (nocase) { + + return JimStringCompareLen(s1, s2, -1, nocase); + } + return JimStringCompare(s1, l1, s2, l2); +} + +int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase) +{ + const char *s1 = Jim_String(firstObjPtr); + const char *s2 = Jim_String(secondObjPtr); + + return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase); +} + +static int JimRelToAbsIndex(int len, int idx) +{ + if (idx < 0) + return len + idx; + return idx; +} + +static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr) +{ + int rangeLen; + + if (*firstPtr > *lastPtr) { + rangeLen = 0; + } + else { + rangeLen = *lastPtr - *firstPtr + 1; + if (rangeLen) { + if (*firstPtr < 0) { + rangeLen += *firstPtr; + *firstPtr = 0; + } + if (*lastPtr >= len) { + rangeLen -= (*lastPtr - (len - 1)); + *lastPtr = len - 1; + } + } + } + if (rangeLen < 0) + rangeLen = 0; + + *rangeLenPtr = rangeLen; +} + +static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, + int len, int *first, int *last, int *range) +{ + if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) { + return JIM_ERR; + } + if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) { + return JIM_ERR; + } + *first = JimRelToAbsIndex(len, *first); + *last = JimRelToAbsIndex(len, *last); + JimRelToAbsRange(len, first, last, range); + return JIM_OK; +} + +Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp, + Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr) +{ + int first, last; + const char *str; + int rangeLen; + int bytelen; + + str = Jim_GetString(strObjPtr, &bytelen); + + if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) { + return NULL; + } + + if (first == 0 && rangeLen == bytelen) { + return strObjPtr; + } + return Jim_NewStringObj(interp, str + first, rangeLen); +} + +Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp, + Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr) +{ +#ifdef JIM_UTF8 + int first, last; + const char *str; + int len, rangeLen; + int bytelen; + + str = Jim_GetString(strObjPtr, &bytelen); + len = Jim_Utf8Length(interp, strObjPtr); + + if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) { + return NULL; + } + + if (first == 0 && rangeLen == len) { + return strObjPtr; + } + if (len == bytelen) { + + return Jim_NewStringObj(interp, str + first, rangeLen); + } + return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen); +#else + return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr); +#endif +} + +Jim_Obj *JimStringReplaceObj(Jim_Interp *interp, + Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj) +{ + int first, last; + const char *str; + int len, rangeLen; + Jim_Obj *objPtr; + + len = Jim_Utf8Length(interp, strObjPtr); + + if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) { + return NULL; + } + + if (last < first) { + return strObjPtr; + } + + str = Jim_String(strObjPtr); + + + objPtr = Jim_NewStringObjUtf8(interp, str, first); + + + if (newStrObj) { + Jim_AppendObj(interp, objPtr, newStrObj); + } + + + Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1); + + return objPtr; +} + +static void JimStrCopyUpperLower(char *dest, const char *str, int uc) +{ + while (*str) { + int c; + str += utf8_tounicode(str, &c); + dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c)); + } + *dest = 0; +} + +static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr) +{ + char *buf; + int len; + const char *str; + + str = Jim_GetString(strObjPtr, &len); + +#ifdef JIM_UTF8 + len *= 2; +#endif + buf = Jim_Alloc(len + 1); + JimStrCopyUpperLower(buf, str, 0); + return Jim_NewStringObjNoAlloc(interp, buf, -1); +} + +static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr) +{ + char *buf; + const char *str; + int len; + + str = Jim_GetString(strObjPtr, &len); + +#ifdef JIM_UTF8 + len *= 2; +#endif + buf = Jim_Alloc(len + 1); + JimStrCopyUpperLower(buf, str, 1); + return Jim_NewStringObjNoAlloc(interp, buf, -1); +} + +static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr) +{ + char *buf, *p; + int len; + int c; + const char *str; + + str = Jim_GetString(strObjPtr, &len); + +#ifdef JIM_UTF8 + len *= 2; +#endif + buf = p = Jim_Alloc(len + 1); + + str += utf8_tounicode(str, &c); + p += utf8_getchars(p, utf8_title(c)); + + JimStrCopyUpperLower(p, str, 0); + + return Jim_NewStringObjNoAlloc(interp, buf, -1); +} + +static const char *utf8_memchr(const char *str, int len, int c) +{ +#ifdef JIM_UTF8 + while (len) { + int sc; + int n = utf8_tounicode(str, &sc); + if (sc == c) { + return str; + } + str += n; + len -= n; + } + return NULL; +#else + return memchr(str, c, len); +#endif +} + +static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen) +{ + while (len) { + int c; + int n = utf8_tounicode(str, &c); + + if (utf8_memchr(trimchars, trimlen, c) == NULL) { + + break; + } + str += n; + len -= n; + } + return str; +} + +static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen) +{ + str += len; + + while (len) { + int c; + int n = utf8_prev_len(str, len); + + len -= n; + str -= n; + + n = utf8_tounicode(str, &c); + + if (utf8_memchr(trimchars, trimlen, c) == NULL) { + return str + n; + } + } + + return NULL; +} + +static const char default_trim_chars[] = " \t\n\r"; + +static int default_trim_chars_len = sizeof(default_trim_chars); + +static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr) +{ + int len; + const char *str = Jim_GetString(strObjPtr, &len); + const char *trimchars = default_trim_chars; + int trimcharslen = default_trim_chars_len; + const char *newstr; + + if (trimcharsObjPtr) { + trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen); + } + + newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen); + if (newstr == str) { + return strObjPtr; + } + + return Jim_NewStringObj(interp, newstr, len - (newstr - str)); +} + +static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr) +{ + int len; + const char *trimchars = default_trim_chars; + int trimcharslen = default_trim_chars_len; + const char *nontrim; + + if (trimcharsObjPtr) { + trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen); + } + + SetStringFromAny(interp, strObjPtr); + + len = Jim_Length(strObjPtr); + nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen); + + if (nontrim == NULL) { + + return Jim_NewEmptyStringObj(interp); + } + if (nontrim == strObjPtr->bytes + len) { + + return strObjPtr; + } + + if (Jim_IsShared(strObjPtr)) { + strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes)); + } + else { + + strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0; + strObjPtr->length = (nontrim - strObjPtr->bytes); + } + + return strObjPtr; +} + +static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr) +{ + + Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr); + + + strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr); + + + if (objPtr != strObjPtr && objPtr->refCount == 0) { + + Jim_FreeNewObj(interp, objPtr); + } + + return strObjPtr; +} + + +#ifdef HAVE_ISASCII +#define jim_isascii isascii +#else +static int jim_isascii(int c) +{ + return !(c & ~0x7f); +} +#endif + +static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict) +{ + static const char * const strclassnames[] = { + "integer", "alpha", "alnum", "ascii", "digit", + "double", "lower", "upper", "space", "xdigit", + "control", "print", "graph", "punct", "boolean", + NULL + }; + enum { + STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT, + STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT, + STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT, STR_IS_BOOLEAN, + }; + int strclass; + int len; + int i; + const char *str; + int (*isclassfunc)(int c) = NULL; + + if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + + str = Jim_GetString(strObjPtr, &len); + if (len == 0) { + Jim_SetResultBool(interp, !strict); + return JIM_OK; + } + + switch (strclass) { + case STR_IS_INTEGER: + { + jim_wide w; + Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK); + return JIM_OK; + } + + case STR_IS_DOUBLE: + { + double d; + Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE); + return JIM_OK; + } + + case STR_IS_BOOLEAN: + { + int b; + Jim_SetResultBool(interp, Jim_GetBoolean(interp, strObjPtr, &b) == JIM_OK); + return JIM_OK; + } + + case STR_IS_ALPHA: isclassfunc = isalpha; break; + case STR_IS_ALNUM: isclassfunc = isalnum; break; + case STR_IS_ASCII: isclassfunc = jim_isascii; break; + case STR_IS_DIGIT: isclassfunc = isdigit; break; + case STR_IS_LOWER: isclassfunc = islower; break; + case STR_IS_UPPER: isclassfunc = isupper; break; + case STR_IS_SPACE: isclassfunc = isspace; break; + case STR_IS_XDIGIT: isclassfunc = isxdigit; break; + case STR_IS_CONTROL: isclassfunc = iscntrl; break; + case STR_IS_PRINT: isclassfunc = isprint; break; + case STR_IS_GRAPH: isclassfunc = isgraph; break; + case STR_IS_PUNCT: isclassfunc = ispunct; break; + default: + return JIM_ERR; + } + + for (i = 0; i < len; i++) { + if (!isclassfunc(UCHAR(str[i]))) { + Jim_SetResultBool(interp, 0); + return JIM_OK; + } + } + Jim_SetResultBool(interp, 1); + return JIM_OK; +} + + + +static const Jim_ObjType comparedStringObjType = { + "compared-string", + NULL, + NULL, + NULL, + JIM_TYPE_REFERENCES, +}; + +int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str) +{ + if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) { + return 1; + } + else { + if (strcmp(str, Jim_String(objPtr)) != 0) + return 0; + + if (objPtr->typePtr != &comparedStringObjType) { + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &comparedStringObjType; + } + objPtr->internalRep.ptr = (char *)str; + return 1; + } +} + +static int qsortCompareStringPointers(const void *a, const void *b) +{ + char *const *sa = (char *const *)a; + char *const *sb = (char *const *)b; + + return strcmp(*sa, *sb); +} + + + +static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); + +static const Jim_ObjType sourceObjType = { + "source", + FreeSourceInternalRep, + DupSourceInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + +void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj); +} + +void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue; + Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj); +} + +static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *fileNameObj, int lineNumber) +{ + JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object")); + JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object")); + Jim_IncrRefCount(fileNameObj); + objPtr->internalRep.sourceValue.fileNameObj = fileNameObj; + objPtr->internalRep.sourceValue.lineNumber = lineNumber; + objPtr->typePtr = &sourceObjType; +} + +static const Jim_ObjType scriptLineObjType = { + "scriptline", + NULL, + NULL, + NULL, + JIM_NONE, +}; + +static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line) +{ + Jim_Obj *objPtr; + +#ifdef DEBUG_SHOW_SCRIPT + char buf[100]; + snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc); + objPtr = Jim_NewStringObj(interp, buf, -1); +#else + objPtr = Jim_NewEmptyStringObj(interp); +#endif + objPtr->typePtr = &scriptLineObjType; + objPtr->internalRep.scriptLineValue.argc = argc; + objPtr->internalRep.scriptLineValue.line = line; + + return objPtr; +} + +static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); + +static const Jim_ObjType scriptObjType = { + "script", + FreeScriptInternalRep, + DupScriptInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + +typedef struct ScriptToken +{ + Jim_Obj *objPtr; + int type; +} ScriptToken; + +typedef struct ScriptObj +{ + ScriptToken *token; + Jim_Obj *fileNameObj; + int len; + int substFlags; + int inUse; /* Used to share a ScriptObj. Currently + only used by Jim_EvalObj() as protection against + shimmering of the currently evaluated object. */ + int firstline; + int linenr; + int missing; +} ScriptObj; + +static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); +static int JimParseCheckMissing(Jim_Interp *interp, int ch); +static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr); + +void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + int i; + struct ScriptObj *script = (void *)objPtr->internalRep.ptr; + + if (--script->inUse != 0) + return; + for (i = 0; i < script->len; i++) { + Jim_DecrRefCount(interp, script->token[i].objPtr); + } + Jim_Free(script->token); + Jim_DecrRefCount(interp, script->fileNameObj); + Jim_Free(script); +} + +void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + JIM_NOTUSED(interp); + JIM_NOTUSED(srcPtr); + + dupPtr->typePtr = NULL; +} + +typedef struct +{ + const char *token; + int len; + int type; + int line; +} ParseToken; + +typedef struct +{ + + ParseToken *list; + int size; + int count; + ParseToken static_list[20]; +} ParseTokenList; + +static void ScriptTokenListInit(ParseTokenList *tokenlist) +{ + tokenlist->list = tokenlist->static_list; + tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken); + tokenlist->count = 0; +} + +static void ScriptTokenListFree(ParseTokenList *tokenlist) +{ + if (tokenlist->list != tokenlist->static_list) { + Jim_Free(tokenlist->list); + } +} + +static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type, + int line) +{ + ParseToken *t; + + if (tokenlist->count == tokenlist->size) { + + tokenlist->size *= 2; + if (tokenlist->list != tokenlist->static_list) { + tokenlist->list = + Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list)); + } + else { + + tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list)); + memcpy(tokenlist->list, tokenlist->static_list, + tokenlist->count * sizeof(*tokenlist->list)); + } + } + t = &tokenlist->list[tokenlist->count++]; + t->token = token; + t->len = len; + t->type = type; + t->line = line; +} + +static int JimCountWordTokens(struct ScriptObj *script, ParseToken *t) +{ + int expand = 1; + int count = 0; + + + if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) { + if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) { + + expand = -1; + t++; + } + else { + if (script->missing == ' ') { + + script->missing = '}'; + script->linenr = t[1].line; + } + } + } + + + while (!TOKEN_IS_SEP(t->type)) { + t++; + count++; + } + + return count * expand; +} + +static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t) +{ + Jim_Obj *objPtr; + + if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) { + + int len = t->len; + char *str = Jim_Alloc(len + 1); + len = JimEscape(str, t->token, len); + objPtr = Jim_NewStringObjNoAlloc(interp, str, len); + } + else { + objPtr = Jim_NewStringObj(interp, t->token, t->len); + } + return objPtr; +} + +static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script, + ParseTokenList *tokenlist) +{ + int i; + struct ScriptToken *token; + + int lineargs = 0; + + ScriptToken *linefirst; + int count; + int linenr; + +#ifdef DEBUG_SHOW_SCRIPT_TOKENS + printf("==== Tokens ====\n"); + for (i = 0; i < tokenlist->count; i++) { + printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type), + tokenlist->list[i].len, tokenlist->list[i].token); + } +#endif + + + count = tokenlist->count; + for (i = 0; i < tokenlist->count; i++) { + if (tokenlist->list[i].type == JIM_TT_EOL) { + count++; + } + } + linenr = script->firstline = tokenlist->list[0].line; + + token = script->token = Jim_Alloc(sizeof(ScriptToken) * count); + + + linefirst = token++; + + for (i = 0; i < tokenlist->count; ) { + + int wordtokens; + + + while (tokenlist->list[i].type == JIM_TT_SEP) { + i++; + } + + wordtokens = JimCountWordTokens(script, tokenlist->list + i); + + if (wordtokens == 0) { + + if (lineargs) { + linefirst->type = JIM_TT_LINE; + linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr); + Jim_IncrRefCount(linefirst->objPtr); + + + lineargs = 0; + linefirst = token++; + } + i++; + continue; + } + else if (wordtokens != 1) { + + token->type = JIM_TT_WORD; + token->objPtr = Jim_NewIntObj(interp, wordtokens); + Jim_IncrRefCount(token->objPtr); + token++; + if (wordtokens < 0) { + + i++; + wordtokens = -wordtokens - 1; + lineargs--; + } + } + + if (lineargs == 0) { + + linenr = tokenlist->list[i].line; + } + lineargs++; + + + while (wordtokens--) { + const ParseToken *t = &tokenlist->list[i++]; + + token->type = t->type; + token->objPtr = JimMakeScriptObj(interp, t); + Jim_IncrRefCount(token->objPtr); + + JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line); + token++; + } + } + + if (lineargs == 0) { + token--; + } + + script->len = token - script->token; + + JimPanic((script->len >= count, "allocated script array is too short")); + +#ifdef DEBUG_SHOW_SCRIPT + printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj)); + for (i = 0; i < script->len; i++) { + const ScriptToken *t = &script->token[i]; + printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr)); + } +#endif + +} + +int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr) +{ + ScriptObj *script = JimGetScript(interp, scriptObj); + if (stateCharPtr) { + *stateCharPtr = script->missing; + } + return script->missing == ' ' || script->missing == '}'; +} + +static int JimParseCheckMissing(Jim_Interp *interp, int ch) +{ + const char *msg; + + switch (ch) { + case '\\': + case ' ': + return JIM_OK; + + case '[': + msg = "unmatched \"[\""; + break; + case '{': + msg = "missing close-brace"; + break; + case '}': + msg = "extra characters after close-brace"; + break; + case '"': + default: + msg = "missing quote"; + break; + } + + Jim_SetResultString(interp, msg, -1); + return JIM_ERR; +} + +static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script, + ParseTokenList *tokenlist) +{ + int i; + struct ScriptToken *token; + + token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count); + + for (i = 0; i < tokenlist->count; i++) { + const ParseToken *t = &tokenlist->list[i]; + + + token->type = t->type; + token->objPtr = JimMakeScriptObj(interp, t); + Jim_IncrRefCount(token->objPtr); + token++; + } + + script->len = i; +} + +static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + int scriptTextLen; + const char *scriptText = Jim_GetString(objPtr, &scriptTextLen); + struct JimParserCtx parser; + struct ScriptObj *script; + ParseTokenList tokenlist; + int line = 1; + + + if (objPtr->typePtr == &sourceObjType) { + line = objPtr->internalRep.sourceValue.lineNumber; + } + + + ScriptTokenListInit(&tokenlist); + + JimParserInit(&parser, scriptText, scriptTextLen, line); + while (!parser.eof) { + JimParseScript(&parser); + ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt, + parser.tline); + } + + + ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0); + + + script = Jim_Alloc(sizeof(*script)); + memset(script, 0, sizeof(*script)); + script->inUse = 1; + if (objPtr->typePtr == &sourceObjType) { + script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; + } + else { + script->fileNameObj = interp->emptyObj; + } + Jim_IncrRefCount(script->fileNameObj); + script->missing = parser.missing.ch; + script->linenr = parser.missing.line; + + ScriptObjAddTokens(interp, script, &tokenlist); + + + ScriptTokenListFree(&tokenlist); + + + Jim_FreeIntRep(interp, objPtr); + Jim_SetIntRepPtr(objPtr, script); + objPtr->typePtr = &scriptObjType; +} + +static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script); + +static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr == interp->emptyObj) { + + objPtr = interp->nullScriptObj; + } + + if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) { + JimSetScriptFromAny(interp, objPtr); + } + + return (ScriptObj *)Jim_GetIntRepPtr(objPtr); +} + +static int JimScriptValid(Jim_Interp *interp, ScriptObj *script) +{ + if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) { + JimAddErrorToStack(interp, script); + return 0; + } + return 1; +} + + +static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr) +{ + cmdPtr->inUse++; +} + +static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr) +{ + if (--cmdPtr->inUse == 0) { + if (cmdPtr->isproc) { + Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr); + Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr); + Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj); + if (cmdPtr->u.proc.staticVars) { + Jim_FreeHashTable(cmdPtr->u.proc.staticVars); + Jim_Free(cmdPtr->u.proc.staticVars); + } + } + else { + + if (cmdPtr->u.native.delProc) { + cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData); + } + } + if (cmdPtr->prevCmd) { + + JimDecrCmdRefCount(interp, cmdPtr->prevCmd); + } + Jim_Free(cmdPtr); + } +} + +static void JimVariablesHTValDestructor(void *interp, void *val) +{ + Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr); + Jim_Free(val); +} + +static const Jim_HashTableType JimVariablesHashTableType = { + JimStringCopyHTHashFunction, + JimStringCopyHTDup, + NULL, + JimStringCopyHTKeyCompare, + JimStringCopyHTKeyDestructor, + JimVariablesHTValDestructor +}; + +static void JimCommandsHT_ValDestructor(void *interp, void *val) +{ + JimDecrCmdRefCount(interp, val); +} + +static const Jim_HashTableType JimCommandsHashTableType = { + JimStringCopyHTHashFunction, + JimStringCopyHTDup, + NULL, + JimStringCopyHTKeyCompare, + JimStringCopyHTKeyDestructor, + JimCommandsHT_ValDestructor +}; + + + +#ifdef jim_ext_namespace +static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj) +{ + const char *name = Jim_String(nsObj); + if (name[0] == ':' && name[1] == ':') { + + while (*++name == ':') { + } + nsObj = Jim_NewStringObj(interp, name, -1); + } + else if (Jim_Length(interp->framePtr->nsObj)) { + + nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj); + Jim_AppendStrings(interp, nsObj, "::", name, NULL); + } + return nsObj; +} + +Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr) +{ + Jim_Obj *resultObj; + + const char *name = Jim_String(nameObjPtr); + if (name[0] == ':' && name[1] == ':') { + return nameObjPtr; + } + Jim_IncrRefCount(nameObjPtr); + resultObj = Jim_NewStringObj(interp, "::", -1); + Jim_AppendObj(interp, resultObj, nameObjPtr); + Jim_DecrRefCount(interp, nameObjPtr); + + return resultObj; +} + +static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr) +{ + Jim_Obj *objPtr = interp->emptyObj; + + if (name[0] == ':' && name[1] == ':') { + + while (*++name == ':') { + } + } + else if (Jim_Length(interp->framePtr->nsObj)) { + + objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj); + Jim_AppendStrings(interp, objPtr, "::", name, NULL); + name = Jim_String(objPtr); + } + Jim_IncrRefCount(objPtr); + *objPtrPtr = objPtr; + return name; +} + + #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ)) + +#else + + #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME)) + #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY) + +Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr) +{ + return nameObjPtr; +} +#endif + +static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd) +{ + Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name); + if (he) { + + Jim_InterpIncrProcEpoch(interp); + } + + if (he && interp->local) { + + cmd->prevCmd = Jim_GetHashEntryVal(he); + Jim_SetHashVal(&interp->commands, he, cmd); + } + else { + if (he) { + + Jim_DeleteHashEntry(&interp->commands, name); + } + + Jim_AddHashEntry(&interp->commands, name, cmd); + } + return JIM_OK; +} + + +int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr, + Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc) +{ + Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr)); + + + memset(cmdPtr, 0, sizeof(*cmdPtr)); + cmdPtr->inUse = 1; + cmdPtr->u.native.delProc = delProc; + cmdPtr->u.native.cmdProc = cmdProc; + cmdPtr->u.native.privData = privData; + + JimCreateCommand(interp, cmdNameStr, cmdPtr); + + return JIM_OK; +} + +static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr) +{ + int len, i; + + len = Jim_ListLength(interp, staticsListObjPtr); + if (len == 0) { + return JIM_OK; + } + + cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable)); + Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp); + for (i = 0; i < len; i++) { + Jim_Obj *objPtr, *initObjPtr, *nameObjPtr; + Jim_Var *varPtr; + int subLen; + + objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i); + + subLen = Jim_ListLength(interp, objPtr); + if (subLen == 1 || subLen == 2) { + nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0); + if (subLen == 1) { + initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE); + if (initObjPtr == NULL) { + Jim_SetResultFormatted(interp, + "variable for initialization of static \"%#s\" not found in the local context", + nameObjPtr); + return JIM_ERR; + } + } + else { + initObjPtr = Jim_ListGetIndex(interp, objPtr, 1); + } + if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) { + return JIM_ERR; + } + + varPtr = Jim_Alloc(sizeof(*varPtr)); + varPtr->objPtr = initObjPtr; + Jim_IncrRefCount(initObjPtr); + varPtr->linkFramePtr = NULL; + if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars, + Jim_String(nameObjPtr), varPtr) != JIM_OK) { + Jim_SetResultFormatted(interp, + "static variable name \"%#s\" duplicated in statics list", nameObjPtr); + Jim_DecrRefCount(interp, initObjPtr); + Jim_Free(varPtr); + return JIM_ERR; + } + } + else { + Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"", + objPtr); + return JIM_ERR; + } + } + return JIM_OK; +} + +static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname) +{ +#ifdef jim_ext_namespace + if (cmdPtr->isproc) { + + const char *pt = strrchr(cmdname, ':'); + if (pt && pt != cmdname && pt[-1] == ':') { + Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj); + cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1); + Jim_IncrRefCount(cmdPtr->u.proc.nsObj); + + if (Jim_FindHashEntry(&interp->commands, pt + 1)) { + + Jim_InterpIncrProcEpoch(interp); + } + } + } +#endif +} + +static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr, + Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj) +{ + Jim_Cmd *cmdPtr; + int argListLen; + int i; + + argListLen = Jim_ListLength(interp, argListObjPtr); + + + cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen); + memset(cmdPtr, 0, sizeof(*cmdPtr)); + cmdPtr->inUse = 1; + cmdPtr->isproc = 1; + cmdPtr->u.proc.argListObjPtr = argListObjPtr; + cmdPtr->u.proc.argListLen = argListLen; + cmdPtr->u.proc.bodyObjPtr = bodyObjPtr; + cmdPtr->u.proc.argsPos = -1; + cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1); + cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj; + Jim_IncrRefCount(argListObjPtr); + Jim_IncrRefCount(bodyObjPtr); + Jim_IncrRefCount(cmdPtr->u.proc.nsObj); + + + if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) { + goto err; + } + + + + for (i = 0; i < argListLen; i++) { + Jim_Obj *argPtr; + Jim_Obj *nameObjPtr; + Jim_Obj *defaultObjPtr; + int len; + + + argPtr = Jim_ListGetIndex(interp, argListObjPtr, i); + len = Jim_ListLength(interp, argPtr); + if (len == 0) { + Jim_SetResultString(interp, "argument with no name", -1); +err: + JimDecrCmdRefCount(interp, cmdPtr); + return NULL; + } + if (len > 2) { + Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr); + goto err; + } + + if (len == 2) { + + nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0); + defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1); + } + else { + + nameObjPtr = argPtr; + defaultObjPtr = NULL; + } + + + if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) { + if (cmdPtr->u.proc.argsPos >= 0) { + Jim_SetResultString(interp, "'args' specified more than once", -1); + goto err; + } + cmdPtr->u.proc.argsPos = i; + } + else { + if (len == 2) { + cmdPtr->u.proc.optArity++; + } + else { + cmdPtr->u.proc.reqArity++; + } + } + + cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr; + cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr; + } + + return cmdPtr; +} + +int Jim_DeleteCommand(Jim_Interp *interp, const char *name) +{ + int ret = JIM_OK; + Jim_Obj *qualifiedNameObj; + const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj); + + if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) { + Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name); + ret = JIM_ERR; + } + else { + Jim_InterpIncrProcEpoch(interp); + } + + JimFreeQualifiedName(interp, qualifiedNameObj); + + return ret; +} + +int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName) +{ + int ret = JIM_ERR; + Jim_HashEntry *he; + Jim_Cmd *cmdPtr; + Jim_Obj *qualifiedOldNameObj; + Jim_Obj *qualifiedNewNameObj; + const char *fqold; + const char *fqnew; + + if (newName[0] == 0) { + return Jim_DeleteCommand(interp, oldName); + } + + fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj); + fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj); + + + he = Jim_FindHashEntry(&interp->commands, fqold); + if (he == NULL) { + Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName); + } + else if (Jim_FindHashEntry(&interp->commands, fqnew)) { + Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName); + } + else { + + cmdPtr = Jim_GetHashEntryVal(he); + JimIncrCmdRefCount(cmdPtr); + JimUpdateProcNamespace(interp, cmdPtr, fqnew); + Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr); + + + Jim_DeleteHashEntry(&interp->commands, fqold); + + + Jim_InterpIncrProcEpoch(interp); + + ret = JIM_OK; + } + + JimFreeQualifiedName(interp, qualifiedOldNameObj); + JimFreeQualifiedName(interp, qualifiedNewNameObj); + + return ret; +} + + +static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj); +} + +static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue; + dupPtr->typePtr = srcPtr->typePtr; + Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj); +} + +static const Jim_ObjType commandObjType = { + "command", + FreeCommandInternalRep, + DupCommandInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + +Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + Jim_Cmd *cmd; + + if (objPtr->typePtr != &commandObjType || + objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch +#ifdef jim_ext_namespace + || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj) +#endif + ) { + + + + const char *name = Jim_String(objPtr); + Jim_HashEntry *he; + + if (name[0] == ':' && name[1] == ':') { + while (*++name == ':') { + } + } +#ifdef jim_ext_namespace + else if (Jim_Length(interp->framePtr->nsObj)) { + + Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj); + Jim_AppendStrings(interp, nameObj, "::", name, NULL); + he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj)); + Jim_FreeNewObj(interp, nameObj); + if (he) { + goto found; + } + } +#endif + + + he = Jim_FindHashEntry(&interp->commands, name); + if (he == NULL) { + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr); + } + return NULL; + } +#ifdef jim_ext_namespace +found: +#endif + cmd = Jim_GetHashEntryVal(he); + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &commandObjType; + objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch; + objPtr->internalRep.cmdValue.cmdPtr = cmd; + objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj; + Jim_IncrRefCount(interp->framePtr->nsObj); + } + else { + cmd = objPtr->internalRep.cmdValue.cmdPtr; + } + while (cmd->u.proc.upcall) { + cmd = cmd->prevCmd; + } + return cmd; +} + + + +#define JIM_DICT_SUGAR 100 + +static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType variableObjType = { + "variable", + NULL, + NULL, + NULL, + JIM_TYPE_REFERENCES, +}; + +static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr) +{ + + if (nameObjPtr->typePtr != &variableObjType) { + int len; + const char *str = Jim_GetString(nameObjPtr, &len); + if (memchr(str, '\0', len)) { + Jim_SetResultFormatted(interp, "%s name contains embedded null", type); + return JIM_ERR; + } + } + return JIM_OK; +} + +static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + const char *varName; + Jim_CallFrame *framePtr; + Jim_HashEntry *he; + int global; + int len; + + + if (objPtr->typePtr == &variableObjType) { + framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr; + if (objPtr->internalRep.varValue.callFrameId == framePtr->id) { + + return JIM_OK; + } + + } + else if (objPtr->typePtr == &dictSubstObjType) { + return JIM_DICT_SUGAR; + } + else if (JimValidName(interp, "variable", objPtr) != JIM_OK) { + return JIM_ERR; + } + + + varName = Jim_GetString(objPtr, &len); + + + if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) { + return JIM_DICT_SUGAR; + } + + if (varName[0] == ':' && varName[1] == ':') { + while (*++varName == ':') { + } + global = 1; + framePtr = interp->topFramePtr; + } + else { + global = 0; + framePtr = interp->framePtr; + } + + + he = Jim_FindHashEntry(&framePtr->vars, varName); + if (he == NULL) { + if (!global && framePtr->staticVars) { + + he = Jim_FindHashEntry(framePtr->staticVars, varName); + } + if (he == NULL) { + return JIM_ERR; + } + } + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &variableObjType; + objPtr->internalRep.varValue.callFrameId = framePtr->id; + objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he); + objPtr->internalRep.varValue.global = global; + return JIM_OK; +} + + +static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr); +static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags); + +static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr) +{ + const char *name; + Jim_CallFrame *framePtr; + int global; + + + Jim_Var *var = Jim_Alloc(sizeof(*var)); + + var->objPtr = valObjPtr; + Jim_IncrRefCount(valObjPtr); + var->linkFramePtr = NULL; + + name = Jim_String(nameObjPtr); + if (name[0] == ':' && name[1] == ':') { + while (*++name == ':') { + } + framePtr = interp->topFramePtr; + global = 1; + } + else { + framePtr = interp->framePtr; + global = 0; + } + + + Jim_AddHashEntry(&framePtr->vars, name, var); + + + Jim_FreeIntRep(interp, nameObjPtr); + nameObjPtr->typePtr = &variableObjType; + nameObjPtr->internalRep.varValue.callFrameId = framePtr->id; + nameObjPtr->internalRep.varValue.varPtr = var; + nameObjPtr->internalRep.varValue.global = global; + + return var; +} + + +int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr) +{ + int err; + Jim_Var *var; + + switch (SetVariableFromAny(interp, nameObjPtr)) { + case JIM_DICT_SUGAR: + return JimDictSugarSet(interp, nameObjPtr, valObjPtr); + + case JIM_ERR: + if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) { + return JIM_ERR; + } + JimCreateVariable(interp, nameObjPtr, valObjPtr); + break; + + case JIM_OK: + var = nameObjPtr->internalRep.varValue.varPtr; + if (var->linkFramePtr == NULL) { + Jim_IncrRefCount(valObjPtr); + Jim_DecrRefCount(interp, var->objPtr); + var->objPtr = valObjPtr; + } + else { + Jim_CallFrame *savedCallFrame; + + savedCallFrame = interp->framePtr; + interp->framePtr = var->linkFramePtr; + err = Jim_SetVariable(interp, var->objPtr, valObjPtr); + interp->framePtr = savedCallFrame; + if (err != JIM_OK) + return err; + } + } + return JIM_OK; +} + +int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr) +{ + Jim_Obj *nameObjPtr; + int result; + + nameObjPtr = Jim_NewStringObj(interp, name, -1); + Jim_IncrRefCount(nameObjPtr); + result = Jim_SetVariable(interp, nameObjPtr, objPtr); + Jim_DecrRefCount(interp, nameObjPtr); + return result; +} + +int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr) +{ + Jim_CallFrame *savedFramePtr; + int result; + + savedFramePtr = interp->framePtr; + interp->framePtr = interp->topFramePtr; + result = Jim_SetVariableStr(interp, name, objPtr); + interp->framePtr = savedFramePtr; + return result; +} + +int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val) +{ + Jim_Obj *valObjPtr; + int result; + + valObjPtr = Jim_NewStringObj(interp, val, -1); + Jim_IncrRefCount(valObjPtr); + result = Jim_SetVariableStr(interp, name, valObjPtr); + Jim_DecrRefCount(interp, valObjPtr); + return result; +} + +int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr, + Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame) +{ + const char *varName; + const char *targetName; + Jim_CallFrame *framePtr; + Jim_Var *varPtr; + + + switch (SetVariableFromAny(interp, nameObjPtr)) { + case JIM_DICT_SUGAR: + + Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr); + return JIM_ERR; + + case JIM_OK: + varPtr = nameObjPtr->internalRep.varValue.varPtr; + + if (varPtr->linkFramePtr == NULL) { + Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr); + return JIM_ERR; + } + + + varPtr->linkFramePtr = NULL; + break; + } + + + + varName = Jim_String(nameObjPtr); + + if (varName[0] == ':' && varName[1] == ':') { + while (*++varName == ':') { + } + + framePtr = interp->topFramePtr; + } + else { + framePtr = interp->framePtr; + } + + targetName = Jim_String(targetNameObjPtr); + if (targetName[0] == ':' && targetName[1] == ':') { + while (*++targetName == ':') { + } + targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1); + targetCallFrame = interp->topFramePtr; + } + Jim_IncrRefCount(targetNameObjPtr); + + if (framePtr->level < targetCallFrame->level) { + Jim_SetResultFormatted(interp, + "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable", + nameObjPtr); + Jim_DecrRefCount(interp, targetNameObjPtr); + return JIM_ERR; + } + + + if (framePtr == targetCallFrame) { + Jim_Obj *objPtr = targetNameObjPtr; + + + while (1) { + if (strcmp(Jim_String(objPtr), varName) == 0) { + Jim_SetResultString(interp, "can't upvar from variable to itself", -1); + Jim_DecrRefCount(interp, targetNameObjPtr); + return JIM_ERR; + } + if (SetVariableFromAny(interp, objPtr) != JIM_OK) + break; + varPtr = objPtr->internalRep.varValue.varPtr; + if (varPtr->linkFramePtr != targetCallFrame) + break; + objPtr = varPtr->objPtr; + } + } + + + Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr); + + nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame; + Jim_DecrRefCount(interp, targetNameObjPtr); + return JIM_OK; +} + +Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags) +{ + switch (SetVariableFromAny(interp, nameObjPtr)) { + case JIM_OK:{ + Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr; + + if (varPtr->linkFramePtr == NULL) { + return varPtr->objPtr; + } + else { + Jim_Obj *objPtr; + + + Jim_CallFrame *savedCallFrame = interp->framePtr; + + interp->framePtr = varPtr->linkFramePtr; + objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags); + interp->framePtr = savedCallFrame; + if (objPtr) { + return objPtr; + } + + } + } + break; + + case JIM_DICT_SUGAR: + + return JimDictSugarGet(interp, nameObjPtr, flags); + } + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr); + } + return NULL; +} + +Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags) +{ + Jim_CallFrame *savedFramePtr; + Jim_Obj *objPtr; + + savedFramePtr = interp->framePtr; + interp->framePtr = interp->topFramePtr; + objPtr = Jim_GetVariable(interp, nameObjPtr, flags); + interp->framePtr = savedFramePtr; + + return objPtr; +} + +Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags) +{ + Jim_Obj *nameObjPtr, *varObjPtr; + + nameObjPtr = Jim_NewStringObj(interp, name, -1); + Jim_IncrRefCount(nameObjPtr); + varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags); + Jim_DecrRefCount(interp, nameObjPtr); + return varObjPtr; +} + +Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags) +{ + Jim_CallFrame *savedFramePtr; + Jim_Obj *objPtr; + + savedFramePtr = interp->framePtr; + interp->framePtr = interp->topFramePtr; + objPtr = Jim_GetVariableStr(interp, name, flags); + interp->framePtr = savedFramePtr; + + return objPtr; +} + +int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags) +{ + Jim_Var *varPtr; + int retval; + Jim_CallFrame *framePtr; + + retval = SetVariableFromAny(interp, nameObjPtr); + if (retval == JIM_DICT_SUGAR) { + + return JimDictSugarSet(interp, nameObjPtr, NULL); + } + else if (retval == JIM_OK) { + varPtr = nameObjPtr->internalRep.varValue.varPtr; + + + if (varPtr->linkFramePtr) { + framePtr = interp->framePtr; + interp->framePtr = varPtr->linkFramePtr; + retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE); + interp->framePtr = framePtr; + } + else { + const char *name = Jim_String(nameObjPtr); + if (nameObjPtr->internalRep.varValue.global) { + name += 2; + framePtr = interp->topFramePtr; + } + else { + framePtr = interp->framePtr; + } + + retval = Jim_DeleteHashEntry(&framePtr->vars, name); + if (retval == JIM_OK) { + + framePtr->id = interp->callFrameEpoch++; + } + } + } + if (retval != JIM_OK && (flags & JIM_ERRMSG)) { + Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr); + } + return retval; +} + + + +static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr) +{ + const char *str, *p; + int len, keyLen; + Jim_Obj *varObjPtr, *keyObjPtr; + + str = Jim_GetString(objPtr, &len); + + p = strchr(str, '('); + JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str)); + + varObjPtr = Jim_NewStringObj(interp, str, p - str); + + p++; + keyLen = (str + len) - p; + if (str[len - 1] == ')') { + keyLen--; + } + + + keyObjPtr = Jim_NewStringObj(interp, p, keyLen); + + Jim_IncrRefCount(varObjPtr); + Jim_IncrRefCount(keyObjPtr); + *varPtrPtr = varObjPtr; + *keyPtrPtr = keyObjPtr; +} + +static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr) +{ + int err; + + SetDictSubstFromAny(interp, objPtr); + + err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, + &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST); + + if (err == JIM_OK) { + + Jim_SetEmptyResult(interp); + } + else { + if (!valObjPtr) { + + if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) { + Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array", + objPtr); + return err; + } + } + + Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array", + (valObjPtr ? "set" : "unset"), objPtr); + } + return err; +} + +static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr, + Jim_Obj *keyObjPtr, int flags) +{ + Jim_Obj *dictObjPtr; + Jim_Obj *resObjPtr = NULL; + int ret; + + dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG); + if (!dictObjPtr) { + return NULL; + } + + ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE); + if (ret != JIM_OK) { + Jim_SetResultFormatted(interp, + "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr, + ret < 0 ? "variable isn't" : "no such element in"); + } + else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) { + + Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr)); + } + + return resObjPtr; +} + + +static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + SetDictSubstFromAny(interp, objPtr); + + return JimDictExpandArrayVariable(interp, + objPtr->internalRep.dictSubstValue.varNameObjPtr, + objPtr->internalRep.dictSubstValue.indexObjPtr, flags); +} + + + +void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr); + Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr); +} + +static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + + dupPtr->internalRep = srcPtr->internalRep; + + Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.varNameObjPtr); + Jim_IncrRefCount(dupPtr->internalRep.dictSubstValue.indexObjPtr); +} + + +static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr->typePtr != &dictSubstObjType) { + Jim_Obj *varObjPtr, *keyObjPtr; + + if (objPtr->typePtr == &interpolatedObjType) { + + + varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr; + keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr; + + Jim_IncrRefCount(varObjPtr); + Jim_IncrRefCount(keyObjPtr); + } + else { + JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr); + } + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &dictSubstObjType; + objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr; + objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr; + } +} + +static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_Obj *resObjPtr = NULL; + Jim_Obj *substKeyObjPtr = NULL; + + SetDictSubstFromAny(interp, objPtr); + + if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr, + &substKeyObjPtr, JIM_NONE) + != JIM_OK) { + return NULL; + } + Jim_IncrRefCount(substKeyObjPtr); + resObjPtr = + JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, + substKeyObjPtr, 0); + Jim_DecrRefCount(interp, substKeyObjPtr); + + return resObjPtr; +} + +static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (Jim_EvalExpression(interp, objPtr) == JIM_OK) { + return Jim_GetResult(interp); + } + return NULL; +} + + +static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj) +{ + Jim_CallFrame *cf; + + if (interp->freeFramesList) { + cf = interp->freeFramesList; + interp->freeFramesList = cf->next; + + cf->argv = NULL; + cf->argc = 0; + cf->procArgsObjPtr = NULL; + cf->procBodyObjPtr = NULL; + cf->next = NULL; + cf->staticVars = NULL; + cf->localCommands = NULL; + cf->tailcallObj = NULL; + cf->tailcallCmd = NULL; + } + else { + cf = Jim_Alloc(sizeof(*cf)); + memset(cf, 0, sizeof(*cf)); + + Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp); + } + + cf->id = interp->callFrameEpoch++; + cf->parent = parent; + cf->level = parent ? parent->level + 1 : 0; + cf->nsObj = nsObj; + Jim_IncrRefCount(nsObj); + + return cf; +} + +static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands) +{ + + if (localCommands) { + Jim_Obj *cmdNameObj; + + while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) { + Jim_HashEntry *he; + Jim_Obj *fqObjName; + Jim_HashTable *ht = &interp->commands; + + const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName); + + he = Jim_FindHashEntry(ht, fqname); + + if (he) { + Jim_Cmd *cmd = Jim_GetHashEntryVal(he); + if (cmd->prevCmd) { + Jim_Cmd *prevCmd = cmd->prevCmd; + cmd->prevCmd = NULL; + + + JimDecrCmdRefCount(interp, cmd); + + + Jim_SetHashVal(ht, he, prevCmd); + } + else { + Jim_DeleteHashEntry(ht, fqname); + } + Jim_InterpIncrProcEpoch(interp); + } + Jim_DecrRefCount(interp, cmdNameObj); + JimFreeQualifiedName(interp, fqObjName); + } + Jim_FreeStack(localCommands); + Jim_Free(localCommands); + } + return JIM_OK; +} + +static int JimInvokeDefer(Jim_Interp *interp, int retcode) +{ + Jim_Obj *objPtr; + + + if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) { + return retcode; + } + + objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE); + + if (objPtr) { + int ret = JIM_OK; + int i; + int listLen = Jim_ListLength(interp, objPtr); + Jim_Obj *resultObjPtr; + + Jim_IncrRefCount(objPtr); + + resultObjPtr = Jim_GetResult(interp); + Jim_IncrRefCount(resultObjPtr); + Jim_SetEmptyResult(interp); + + + for (i = listLen; i > 0; i--) { + + Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1); + ret = Jim_EvalObj(interp, scriptObjPtr); + if (ret != JIM_OK) { + break; + } + } + + if (ret == JIM_OK || retcode == JIM_ERR) { + + Jim_SetResult(interp, resultObjPtr); + } + else { + retcode = ret; + } + + Jim_DecrRefCount(interp, resultObjPtr); + Jim_DecrRefCount(interp, objPtr); + } + return retcode; +} + +#define JIM_FCF_FULL 0 +#define JIM_FCF_REUSE 1 +static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action) + { + JimDeleteLocalProcs(interp, cf->localCommands); + + if (cf->procArgsObjPtr) + Jim_DecrRefCount(interp, cf->procArgsObjPtr); + if (cf->procBodyObjPtr) + Jim_DecrRefCount(interp, cf->procBodyObjPtr); + Jim_DecrRefCount(interp, cf->nsObj); + if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE) + Jim_FreeHashTable(&cf->vars); + else { + int i; + Jim_HashEntry **table = cf->vars.table, *he; + + for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) { + he = table[i]; + while (he != NULL) { + Jim_HashEntry *nextEntry = he->next; + Jim_Var *varPtr = Jim_GetHashEntryVal(he); + + Jim_DecrRefCount(interp, varPtr->objPtr); + Jim_Free(Jim_GetHashEntryKey(he)); + Jim_Free(varPtr); + Jim_Free(he); + table[i] = NULL; + he = nextEntry; + } + } + cf->vars.used = 0; + } + cf->next = interp->freeFramesList; + interp->freeFramesList = cf; +} + + + +int Jim_IsBigEndian(void) +{ + union { + unsigned short s; + unsigned char c[2]; + } uval = {0x0102}; + + return uval.c[0] == 1; +} + + +Jim_Interp *Jim_CreateInterp(void) +{ + Jim_Interp *i = Jim_Alloc(sizeof(*i)); + + memset(i, 0, sizeof(*i)); + + i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH; + i->maxEvalDepth = JIM_MAX_EVAL_DEPTH; + i->lastCollectTime = time(NULL); + + Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i); +#ifdef JIM_REFERENCES + Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i); +#endif + Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i); + Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL); + i->emptyObj = Jim_NewEmptyStringObj(i); + i->trueObj = Jim_NewIntObj(i, 1); + i->falseObj = Jim_NewIntObj(i, 0); + i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj); + i->errorFileNameObj = i->emptyObj; + i->result = i->emptyObj; + i->stackTrace = Jim_NewListObj(i, NULL, 0); + i->unknown = Jim_NewStringObj(i, "unknown", -1); + i->errorProc = i->emptyObj; + i->currentScriptObj = Jim_NewEmptyStringObj(i); + i->nullScriptObj = Jim_NewEmptyStringObj(i); + Jim_IncrRefCount(i->emptyObj); + Jim_IncrRefCount(i->errorFileNameObj); + Jim_IncrRefCount(i->result); + Jim_IncrRefCount(i->stackTrace); + Jim_IncrRefCount(i->unknown); + Jim_IncrRefCount(i->currentScriptObj); + Jim_IncrRefCount(i->nullScriptObj); + Jim_IncrRefCount(i->errorProc); + Jim_IncrRefCount(i->trueObj); + Jim_IncrRefCount(i->falseObj); + + + Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY); + Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0"); + + Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim"); + Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS); + Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM); + Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR); + Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian"); + Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0"); + Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *))); + Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide))); + + return i; +} + +void Jim_FreeInterp(Jim_Interp *i) +{ + Jim_CallFrame *cf, *cfx; + + Jim_Obj *objPtr, *nextObjPtr; + + + for (cf = i->framePtr; cf; cf = cfx) { + + JimInvokeDefer(i, JIM_OK); + cfx = cf->parent; + JimFreeCallFrame(i, cf, JIM_FCF_FULL); + } + + Jim_DecrRefCount(i, i->emptyObj); + Jim_DecrRefCount(i, i->trueObj); + Jim_DecrRefCount(i, i->falseObj); + Jim_DecrRefCount(i, i->result); + Jim_DecrRefCount(i, i->stackTrace); + Jim_DecrRefCount(i, i->errorProc); + Jim_DecrRefCount(i, i->unknown); + Jim_DecrRefCount(i, i->errorFileNameObj); + Jim_DecrRefCount(i, i->currentScriptObj); + Jim_DecrRefCount(i, i->nullScriptObj); + Jim_FreeHashTable(&i->commands); +#ifdef JIM_REFERENCES + Jim_FreeHashTable(&i->references); +#endif + Jim_FreeHashTable(&i->packages); + Jim_Free(i->prngState); + Jim_FreeHashTable(&i->assocData); + +#ifdef JIM_MAINTAINER + if (i->liveList != NULL) { + objPtr = i->liveList; + + printf("\n-------------------------------------\n"); + printf("Objects still in the free list:\n"); + while (objPtr) { + const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string"; + Jim_String(objPtr); + + if (objPtr->bytes && strlen(objPtr->bytes) > 20) { + printf("%p (%d) %-10s: '%.20s...'\n", + (void *)objPtr, objPtr->refCount, type, objPtr->bytes); + } + else { + printf("%p (%d) %-10s: '%s'\n", + (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)"); + } + if (objPtr->typePtr == &sourceObjType) { + printf("FILE %s LINE %d\n", + Jim_String(objPtr->internalRep.sourceValue.fileNameObj), + objPtr->internalRep.sourceValue.lineNumber); + } + objPtr = objPtr->nextObjPtr; + } + printf("-------------------------------------\n\n"); + JimPanic((1, "Live list non empty freeing the interpreter! Leak?")); + } +#endif + + + objPtr = i->freeList; + while (objPtr) { + nextObjPtr = objPtr->nextObjPtr; + Jim_Free(objPtr); + objPtr = nextObjPtr; + } + + + for (cf = i->freeFramesList; cf; cf = cfx) { + cfx = cf->next; + if (cf->vars.table) + Jim_FreeHashTable(&cf->vars); + Jim_Free(cf); + } + + + Jim_Free(i); +} + +Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr) +{ + long level; + const char *str; + Jim_CallFrame *framePtr; + + if (levelObjPtr) { + str = Jim_String(levelObjPtr); + if (str[0] == '#') { + char *endptr; + + level = jim_strtol(str + 1, &endptr); + if (str[1] == '\0' || endptr[0] != '\0') { + level = -1; + } + } + else { + if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) { + level = -1; + } + else { + + level = interp->framePtr->level - level; + } + } + } + else { + str = "1"; + level = interp->framePtr->level - 1; + } + + if (level == 0) { + return interp->topFramePtr; + } + if (level > 0) { + + for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) { + if (framePtr->level == level) { + return framePtr; + } + } + } + + Jim_SetResultFormatted(interp, "bad level \"%s\"", str); + return NULL; +} + +static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr) +{ + long level; + Jim_CallFrame *framePtr; + + if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) { + if (level <= 0) { + + level = interp->framePtr->level + level; + } + + if (level == 0) { + return interp->topFramePtr; + } + + + for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) { + if (framePtr->level == level) { + return framePtr; + } + } + } + + Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr); + return NULL; +} + +static void JimResetStackTrace(Jim_Interp *interp) +{ + Jim_DecrRefCount(interp, interp->stackTrace); + interp->stackTrace = Jim_NewListObj(interp, NULL, 0); + Jim_IncrRefCount(interp->stackTrace); +} + +static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj) +{ + int len; + + + Jim_IncrRefCount(stackTraceObj); + Jim_DecrRefCount(interp, interp->stackTrace); + interp->stackTrace = stackTraceObj; + interp->errorFlag = 1; + + len = Jim_ListLength(interp, interp->stackTrace); + if (len >= 3) { + if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) { + interp->addStackTrace = 1; + } + } +} + +static void JimAppendStackTrace(Jim_Interp *interp, const char *procname, + Jim_Obj *fileNameObj, int linenr) +{ + if (strcmp(procname, "unknown") == 0) { + procname = ""; + } + if (!*procname && !Jim_Length(fileNameObj)) { + + return; + } + + if (Jim_IsShared(interp->stackTrace)) { + Jim_DecrRefCount(interp, interp->stackTrace); + interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace); + Jim_IncrRefCount(interp->stackTrace); + } + + + if (!*procname && Jim_Length(fileNameObj)) { + + int len = Jim_ListLength(interp, interp->stackTrace); + + if (len >= 3) { + Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3); + if (Jim_Length(objPtr)) { + + objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2); + if (Jim_Length(objPtr) == 0) { + + ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0); + ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0); + return; + } + } + } + } + + Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1)); + Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj); + Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr)); +} + +int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc, + void *data) +{ + AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue)); + + assocEntryPtr->delProc = delProc; + assocEntryPtr->data = data; + return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr); +} + +void *Jim_GetAssocData(Jim_Interp *interp, const char *key) +{ + Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key); + + if (entryPtr != NULL) { + AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr); + return assocEntryPtr->data; + } + return NULL; +} + +int Jim_DeleteAssocData(Jim_Interp *interp, const char *key) +{ + return Jim_DeleteHashEntry(&interp->assocData, key); +} + +int Jim_GetExitCode(Jim_Interp *interp) +{ + return interp->exitCode; +} + +static void UpdateStringOfInt(struct Jim_Obj *objPtr); +static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags); + +static const Jim_ObjType intObjType = { + "int", + NULL, + NULL, + UpdateStringOfInt, + JIM_TYPE_NONE, +}; + +static const Jim_ObjType coercedDoubleObjType = { + "coerced-double", + NULL, + NULL, + UpdateStringOfInt, + JIM_TYPE_NONE, +}; + + +static void UpdateStringOfInt(struct Jim_Obj *objPtr) +{ + char buf[JIM_INTEGER_SPACE + 1]; + jim_wide wideValue = JimWideValue(objPtr); + int pos = 0; + + if (wideValue == 0) { + buf[pos++] = '0'; + } + else { + char tmp[JIM_INTEGER_SPACE]; + int num = 0; + int i; + + if (wideValue < 0) { + buf[pos++] = '-'; + i = wideValue % 10; + tmp[num++] = (i > 0) ? (10 - i) : -i; + wideValue /= -10; + } + + while (wideValue) { + tmp[num++] = wideValue % 10; + wideValue /= 10; + } + + for (i = 0; i < num; i++) { + buf[pos++] = '0' + tmp[num - i - 1]; + } + } + buf[pos] = 0; + + JimSetStringBytes(objPtr, buf); +} + +static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + jim_wide wideValue; + const char *str; + + if (objPtr->typePtr == &coercedDoubleObjType) { + + objPtr->typePtr = &intObjType; + return JIM_OK; + } + + + str = Jim_String(objPtr); + + if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) { + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr); + } + return JIM_ERR; + } + if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) { + Jim_SetResultString(interp, "Integer value too big to be represented", -1); + return JIM_ERR; + } + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &intObjType; + objPtr->internalRep.wideValue = wideValue; + return JIM_OK; +} + +#ifdef JIM_OPTIMIZATION +static int JimIsWide(Jim_Obj *objPtr) +{ + return objPtr->typePtr == &intObjType; +} +#endif + +int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr) +{ + if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR) + return JIM_ERR; + *widePtr = JimWideValue(objPtr); + return JIM_OK; +} + + +static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr) +{ + if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR) + return JIM_ERR; + *widePtr = JimWideValue(objPtr); + return JIM_OK; +} + +int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr) +{ + jim_wide wideValue; + int retval; + + retval = Jim_GetWide(interp, objPtr, &wideValue); + if (retval == JIM_OK) { + *longPtr = (long)wideValue; + return JIM_OK; + } + return JIM_ERR; +} + +Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue) +{ + Jim_Obj *objPtr; + + objPtr = Jim_NewObj(interp); + objPtr->typePtr = &intObjType; + objPtr->bytes = NULL; + objPtr->internalRep.wideValue = wideValue; + return objPtr; +} + +#define JIM_DOUBLE_SPACE 30 + +static void UpdateStringOfDouble(struct Jim_Obj *objPtr); +static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr); + +static const Jim_ObjType doubleObjType = { + "double", + NULL, + NULL, + UpdateStringOfDouble, + JIM_TYPE_NONE, +}; + +#ifndef HAVE_ISNAN +#undef isnan +#define isnan(X) ((X) != (X)) +#endif +#ifndef HAVE_ISINF +#undef isinf +#define isinf(X) (1.0 / (X) == 0.0) +#endif + +static void UpdateStringOfDouble(struct Jim_Obj *objPtr) +{ + double value = objPtr->internalRep.doubleValue; + + if (isnan(value)) { + JimSetStringBytes(objPtr, "NaN"); + return; + } + if (isinf(value)) { + if (value < 0) { + JimSetStringBytes(objPtr, "-Inf"); + } + else { + JimSetStringBytes(objPtr, "Inf"); + } + return; + } + { + char buf[JIM_DOUBLE_SPACE + 1]; + int i; + int len = sprintf(buf, "%.12g", value); + + + for (i = 0; i < len; i++) { + if (buf[i] == '.' || buf[i] == 'e') { +#if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX) + char *e = strchr(buf, 'e'); + if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') { + + e += 2; + memmove(e, e + 1, len - (e - buf)); + } +#endif + break; + } + } + if (buf[i] == '\0') { + buf[i++] = '.'; + buf[i++] = '0'; + buf[i] = '\0'; + } + JimSetStringBytes(objPtr, buf); + } +} + +static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + double doubleValue; + jim_wide wideValue; + const char *str; + +#ifdef HAVE_LONG_LONG + +#define MIN_INT_IN_DOUBLE -(1LL << 53) +#define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1) + + if (objPtr->typePtr == &intObjType + && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE + && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) { + + + objPtr->typePtr = &coercedDoubleObjType; + return JIM_OK; + } +#endif + str = Jim_String(objPtr); + + if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) { + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &coercedDoubleObjType; + objPtr->internalRep.wideValue = wideValue; + return JIM_OK; + } + else { + + if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) { + Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr); + return JIM_ERR; + } + + Jim_FreeIntRep(interp, objPtr); + } + objPtr->typePtr = &doubleObjType; + objPtr->internalRep.doubleValue = doubleValue; + return JIM_OK; +} + +int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr) +{ + if (objPtr->typePtr == &coercedDoubleObjType) { + *doublePtr = JimWideValue(objPtr); + return JIM_OK; + } + if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR) + return JIM_ERR; + + if (objPtr->typePtr == &coercedDoubleObjType) { + *doublePtr = JimWideValue(objPtr); + } + else { + *doublePtr = objPtr->internalRep.doubleValue; + } + return JIM_OK; +} + +Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue) +{ + Jim_Obj *objPtr; + + objPtr = Jim_NewObj(interp); + objPtr->typePtr = &doubleObjType; + objPtr->bytes = NULL; + objPtr->internalRep.doubleValue = doubleValue; + return objPtr; +} + +static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags); + +int Jim_GetBoolean(Jim_Interp *interp, Jim_Obj *objPtr, int * booleanPtr) +{ + if (objPtr->typePtr != &intObjType && SetBooleanFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR) + return JIM_ERR; + *booleanPtr = (int) JimWideValue(objPtr); + return JIM_OK; +} + +static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + static const char * const falses[] = { + "0", "false", "no", "off", NULL + }; + static const char * const trues[] = { + "1", "true", "yes", "on", NULL + }; + + int boolean; + + int index; + if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) { + boolean = 0; + } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) { + boolean = 1; + } else { + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr); + } + return JIM_ERR; + } + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &intObjType; + objPtr->internalRep.wideValue = boolean; + return JIM_OK; +} + +static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec); +static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr); +static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static void UpdateStringOfList(struct Jim_Obj *objPtr); +static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType listObjType = { + "list", + FreeListInternalRep, + DupListInternalRep, + UpdateStringOfList, + JIM_TYPE_NONE, +}; + +void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + int i; + + for (i = 0; i < objPtr->internalRep.listValue.len; i++) { + Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]); + } + Jim_Free(objPtr->internalRep.listValue.ele); +} + +void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + int i; + + JIM_NOTUSED(interp); + + dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len; + dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen; + dupPtr->internalRep.listValue.ele = + Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen); + memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele, + sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len); + for (i = 0; i < dupPtr->internalRep.listValue.len; i++) { + Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]); + } + dupPtr->typePtr = &listObjType; +} + +#define JIM_ELESTR_SIMPLE 0 +#define JIM_ELESTR_BRACE 1 +#define JIM_ELESTR_QUOTE 2 +static unsigned char ListElementQuotingType(const char *s, int len) +{ + int i, level, blevel, trySimple = 1; + + + if (len == 0) + return JIM_ELESTR_BRACE; + if (s[0] == '"' || s[0] == '{') { + trySimple = 0; + goto testbrace; + } + for (i = 0; i < len; i++) { + switch (s[i]) { + case ' ': + case '$': + case '"': + case '[': + case ']': + case ';': + case '\\': + case '\r': + case '\n': + case '\t': + case '\f': + case '\v': + trySimple = 0; + + case '{': + case '}': + goto testbrace; + } + } + return JIM_ELESTR_SIMPLE; + + testbrace: + + if (s[len - 1] == '\\') + return JIM_ELESTR_QUOTE; + level = 0; + blevel = 0; + for (i = 0; i < len; i++) { + switch (s[i]) { + case '{': + level++; + break; + case '}': + level--; + if (level < 0) + return JIM_ELESTR_QUOTE; + break; + case '[': + blevel++; + break; + case ']': + blevel--; + break; + case '\\': + if (s[i + 1] == '\n') + return JIM_ELESTR_QUOTE; + else if (s[i + 1] != '\0') + i++; + break; + } + } + if (blevel < 0) { + return JIM_ELESTR_QUOTE; + } + + if (level == 0) { + if (!trySimple) + return JIM_ELESTR_BRACE; + for (i = 0; i < len; i++) { + switch (s[i]) { + case ' ': + case '$': + case '"': + case '[': + case ']': + case ';': + case '\\': + case '\r': + case '\n': + case '\t': + case '\f': + case '\v': + return JIM_ELESTR_BRACE; + break; + } + } + return JIM_ELESTR_SIMPLE; + } + return JIM_ELESTR_QUOTE; +} + +static int BackslashQuoteString(const char *s, int len, char *q) +{ + char *p = q; + + while (len--) { + switch (*s) { + case ' ': + case '$': + case '"': + case '[': + case ']': + case '{': + case '}': + case ';': + case '\\': + *p++ = '\\'; + *p++ = *s++; + break; + case '\n': + *p++ = '\\'; + *p++ = 'n'; + s++; + break; + case '\r': + *p++ = '\\'; + *p++ = 'r'; + s++; + break; + case '\t': + *p++ = '\\'; + *p++ = 't'; + s++; + break; + case '\f': + *p++ = '\\'; + *p++ = 'f'; + s++; + break; + case '\v': + *p++ = '\\'; + *p++ = 'v'; + s++; + break; + default: + *p++ = *s++; + break; + } + } + *p = '\0'; + + return p - q; +} + +static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc) +{ + #define STATIC_QUOTING_LEN 32 + int i, bufLen, realLength; + const char *strRep; + char *p; + unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN]; + + + if (objc > STATIC_QUOTING_LEN) { + quotingType = Jim_Alloc(objc); + } + else { + quotingType = staticQuoting; + } + bufLen = 0; + for (i = 0; i < objc; i++) { + int len; + + strRep = Jim_GetString(objv[i], &len); + quotingType[i] = ListElementQuotingType(strRep, len); + switch (quotingType[i]) { + case JIM_ELESTR_SIMPLE: + if (i != 0 || strRep[0] != '#') { + bufLen += len; + break; + } + + quotingType[i] = JIM_ELESTR_BRACE; + + case JIM_ELESTR_BRACE: + bufLen += len + 2; + break; + case JIM_ELESTR_QUOTE: + bufLen += len * 2; + break; + } + bufLen++; + } + bufLen++; + + + p = objPtr->bytes = Jim_Alloc(bufLen + 1); + realLength = 0; + for (i = 0; i < objc; i++) { + int len, qlen; + + strRep = Jim_GetString(objv[i], &len); + + switch (quotingType[i]) { + case JIM_ELESTR_SIMPLE: + memcpy(p, strRep, len); + p += len; + realLength += len; + break; + case JIM_ELESTR_BRACE: + *p++ = '{'; + memcpy(p, strRep, len); + p += len; + *p++ = '}'; + realLength += len + 2; + break; + case JIM_ELESTR_QUOTE: + if (i == 0 && strRep[0] == '#') { + *p++ = '\\'; + realLength++; + } + qlen = BackslashQuoteString(strRep, len, p); + p += qlen; + realLength += qlen; + break; + } + + if (i + 1 != objc) { + *p++ = ' '; + realLength++; + } + } + *p = '\0'; + objPtr->length = realLength; + + if (quotingType != staticQuoting) { + Jim_Free(quotingType); + } +} + +static void UpdateStringOfList(struct Jim_Obj *objPtr) +{ + JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len); +} + +static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + struct JimParserCtx parser; + const char *str; + int strLen; + Jim_Obj *fileNameObj; + int linenr; + + if (objPtr->typePtr == &listObjType) { + return JIM_OK; + } + + if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) { + Jim_Obj **listObjPtrPtr; + int len; + int i; + + listObjPtrPtr = JimDictPairs(objPtr, &len); + for (i = 0; i < len; i++) { + Jim_IncrRefCount(listObjPtrPtr[i]); + } + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &listObjType; + objPtr->internalRep.listValue.len = len; + objPtr->internalRep.listValue.maxLen = len; + objPtr->internalRep.listValue.ele = listObjPtrPtr; + + return JIM_OK; + } + + + if (objPtr->typePtr == &sourceObjType) { + fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; + linenr = objPtr->internalRep.sourceValue.lineNumber; + } + else { + fileNameObj = interp->emptyObj; + linenr = 1; + } + Jim_IncrRefCount(fileNameObj); + + + str = Jim_GetString(objPtr, &strLen); + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &listObjType; + objPtr->internalRep.listValue.len = 0; + objPtr->internalRep.listValue.maxLen = 0; + objPtr->internalRep.listValue.ele = NULL; + + + if (strLen) { + JimParserInit(&parser, str, strLen, linenr); + while (!parser.eof) { + Jim_Obj *elementPtr; + + JimParseList(&parser); + if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC) + continue; + elementPtr = JimParserGetTokenObj(interp, &parser); + JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline); + ListAppendElement(objPtr, elementPtr); + } + } + Jim_DecrRefCount(interp, fileNameObj); + return JIM_OK; +} + +Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len) +{ + Jim_Obj *objPtr; + + objPtr = Jim_NewObj(interp); + objPtr->typePtr = &listObjType; + objPtr->bytes = NULL; + objPtr->internalRep.listValue.ele = NULL; + objPtr->internalRep.listValue.len = 0; + objPtr->internalRep.listValue.maxLen = 0; + + if (len) { + ListInsertElements(objPtr, 0, len, elements); + } + + return objPtr; +} + +static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen, + Jim_Obj ***listVec) +{ + *listLen = Jim_ListLength(interp, listObj); + *listVec = listObj->internalRep.listValue.ele; +} + + +static int JimSign(jim_wide w) +{ + if (w == 0) { + return 0; + } + else if (w < 0) { + return -1; + } + return 1; +} + + +struct lsort_info { + jmp_buf jmpbuf; + Jim_Obj *command; + Jim_Interp *interp; + enum { + JIM_LSORT_ASCII, + JIM_LSORT_NOCASE, + JIM_LSORT_INTEGER, + JIM_LSORT_REAL, + JIM_LSORT_COMMAND + } type; + int order; + int index; + int indexed; + int unique; + int (*subfn)(Jim_Obj **, Jim_Obj **); +}; + +static struct lsort_info *sort_info; + +static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + Jim_Obj *lObj, *rObj; + + if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK || + Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) { + longjmp(sort_info->jmpbuf, JIM_ERR); + } + return sort_info->subfn(&lObj, &rObj); +} + + +static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order; +} + +static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order; +} + +static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + jim_wide lhs = 0, rhs = 0; + + if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK || + Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) { + longjmp(sort_info->jmpbuf, JIM_ERR); + } + + return JimSign(lhs - rhs) * sort_info->order; +} + +static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + double lhs = 0, rhs = 0; + + if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK || + Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) { + longjmp(sort_info->jmpbuf, JIM_ERR); + } + if (lhs == rhs) { + return 0; + } + if (lhs > rhs) { + return sort_info->order; + } + return -sort_info->order; +} + +static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + Jim_Obj *compare_script; + int rc; + + jim_wide ret = 0; + + + compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command); + Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj); + Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj); + + rc = Jim_EvalObj(sort_info->interp, compare_script); + + if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) { + longjmp(sort_info->jmpbuf, rc); + } + + return JimSign(ret) * sort_info->order; +} + +static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs)) +{ + int src; + int dst = 0; + Jim_Obj **ele = listObjPtr->internalRep.listValue.ele; + + for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) { + if (comp(&ele[dst], &ele[src]) == 0) { + + Jim_DecrRefCount(sort_info->interp, ele[dst]); + } + else { + + dst++; + } + ele[dst] = ele[src]; + } + + + dst++; + if (dst < listObjPtr->internalRep.listValue.len) { + ele[dst] = ele[src]; + } + + + listObjPtr->internalRep.listValue.len = dst; +} + + +static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info) +{ + struct lsort_info *prev_info; + + typedef int (qsort_comparator) (const void *, const void *); + int (*fn) (Jim_Obj **, Jim_Obj **); + Jim_Obj **vector; + int len; + int rc; + + JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object")); + SetListFromAny(interp, listObjPtr); + + + prev_info = sort_info; + sort_info = info; + + vector = listObjPtr->internalRep.listValue.ele; + len = listObjPtr->internalRep.listValue.len; + switch (info->type) { + case JIM_LSORT_ASCII: + fn = ListSortString; + break; + case JIM_LSORT_NOCASE: + fn = ListSortStringNoCase; + break; + case JIM_LSORT_INTEGER: + fn = ListSortInteger; + break; + case JIM_LSORT_REAL: + fn = ListSortReal; + break; + case JIM_LSORT_COMMAND: + fn = ListSortCommand; + break; + default: + fn = NULL; + JimPanic((1, "ListSort called with invalid sort type")); + return -1; + } + + if (info->indexed) { + + info->subfn = fn; + fn = ListSortIndexHelper; + } + + if ((rc = setjmp(info->jmpbuf)) == 0) { + qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn); + + if (info->unique && len > 1) { + ListRemoveDuplicates(listObjPtr, fn); + } + + Jim_InvalidateStringRep(listObjPtr); + } + sort_info = prev_info; + + return rc; +} + +static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec) +{ + int currentLen = listPtr->internalRep.listValue.len; + int requiredLen = currentLen + elemc; + int i; + Jim_Obj **point; + + if (requiredLen > listPtr->internalRep.listValue.maxLen) { + if (requiredLen < 2) { + + requiredLen = 4; + } + else { + requiredLen *= 2; + } + + listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele, + sizeof(Jim_Obj *) * requiredLen); + + listPtr->internalRep.listValue.maxLen = requiredLen; + } + if (idx < 0) { + idx = currentLen; + } + point = listPtr->internalRep.listValue.ele + idx; + memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *)); + for (i = 0; i < elemc; ++i) { + point[i] = elemVec[i]; + Jim_IncrRefCount(point[i]); + } + listPtr->internalRep.listValue.len += elemc; +} + +static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr) +{ + ListInsertElements(listPtr, -1, 1, &objPtr); +} + +static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr) +{ + ListInsertElements(listPtr, -1, + appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele); +} + +void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr) +{ + JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object")); + SetListFromAny(interp, listPtr); + Jim_InvalidateStringRep(listPtr); + ListAppendElement(listPtr, objPtr); +} + +void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr) +{ + JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object")); + SetListFromAny(interp, listPtr); + SetListFromAny(interp, appendListPtr); + Jim_InvalidateStringRep(listPtr); + ListAppendList(listPtr, appendListPtr); +} + +int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr) +{ + SetListFromAny(interp, objPtr); + return objPtr->internalRep.listValue.len; +} + +void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx, + int objc, Jim_Obj *const *objVec) +{ + JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object")); + SetListFromAny(interp, listPtr); + if (idx >= 0 && idx > listPtr->internalRep.listValue.len) + idx = listPtr->internalRep.listValue.len; + else if (idx < 0) + idx = 0; + Jim_InvalidateStringRep(listPtr); + ListInsertElements(listPtr, idx, objc, objVec); +} + +Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx) +{ + SetListFromAny(interp, listPtr); + if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) || + (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) { + return NULL; + } + if (idx < 0) + idx = listPtr->internalRep.listValue.len + idx; + return listPtr->internalRep.listValue.ele[idx]; +} + +int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags) +{ + *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx); + if (*objPtrPtr == NULL) { + if (flags & JIM_ERRMSG) { + Jim_SetResultString(interp, "list index out of range", -1); + } + return JIM_ERR; + } + return JIM_OK; +} + +static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, + Jim_Obj *newObjPtr, int flags) +{ + SetListFromAny(interp, listPtr); + if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) || + (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) { + if (flags & JIM_ERRMSG) { + Jim_SetResultString(interp, "list index out of range", -1); + } + return JIM_ERR; + } + if (idx < 0) + idx = listPtr->internalRep.listValue.len + idx; + Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]); + listPtr->internalRep.listValue.ele[idx] = newObjPtr; + Jim_IncrRefCount(newObjPtr); + return JIM_OK; +} + +int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr, + Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr) +{ + Jim_Obj *varObjPtr, *objPtr, *listObjPtr; + int shared, i, idx; + + varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED); + if (objPtr == NULL) + return JIM_ERR; + if ((shared = Jim_IsShared(objPtr))) + varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr); + for (i = 0; i < indexc - 1; i++) { + listObjPtr = objPtr; + if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK) + goto err; + if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) { + goto err; + } + if (Jim_IsShared(objPtr)) { + objPtr = Jim_DuplicateObj(interp, objPtr); + ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE); + } + Jim_InvalidateStringRep(listObjPtr); + } + if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK) + goto err; + if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR) + goto err; + Jim_InvalidateStringRep(objPtr); + Jim_InvalidateStringRep(varObjPtr); + if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) + goto err; + Jim_SetResult(interp, varObjPtr); + return JIM_OK; + err: + if (shared) { + Jim_FreeNewObj(interp, varObjPtr); + } + return JIM_ERR; +} + +Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen) +{ + int i; + int listLen = Jim_ListLength(interp, listObjPtr); + Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp); + + for (i = 0; i < listLen; ) { + Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i)); + if (++i != listLen) { + Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen); + } + } + return resObjPtr; +} + +Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv) +{ + int i; + + for (i = 0; i < objc; i++) { + if (!Jim_IsList(objv[i])) + break; + } + if (i == objc) { + Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0); + + for (i = 0; i < objc; i++) + ListAppendList(objPtr, objv[i]); + return objPtr; + } + else { + + int len = 0, objLen; + char *bytes, *p; + + + for (i = 0; i < objc; i++) { + len += Jim_Length(objv[i]); + } + if (objc) + len += objc - 1; + + p = bytes = Jim_Alloc(len + 1); + for (i = 0; i < objc; i++) { + const char *s = Jim_GetString(objv[i], &objLen); + + + while (objLen && isspace(UCHAR(*s))) { + s++; + objLen--; + len--; + } + + while (objLen && isspace(UCHAR(s[objLen - 1]))) { + + if (objLen > 1 && s[objLen - 2] == '\\') { + break; + } + objLen--; + len--; + } + memcpy(p, s, objLen); + p += objLen; + if (i + 1 != objc) { + if (objLen) + *p++ = ' '; + else { + len--; + } + } + } + *p = '\0'; + return Jim_NewStringObjNoAlloc(interp, bytes, len); + } +} + +Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, + Jim_Obj *lastObjPtr) +{ + int first, last; + int len, rangeLen; + + if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK || + Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK) + return NULL; + len = Jim_ListLength(interp, listObjPtr); + first = JimRelToAbsIndex(len, first); + last = JimRelToAbsIndex(len, last); + JimRelToAbsRange(len, &first, &last, &rangeLen); + if (first == 0 && last == len) { + return listObjPtr; + } + return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen); +} + +static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static void UpdateStringOfDict(struct Jim_Obj *objPtr); +static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + + +static unsigned int JimObjectHTHashFunction(const void *key) +{ + int len; + const char *str = Jim_GetString((Jim_Obj *)key, &len); + return Jim_GenHashFunction((const unsigned char *)str, len); +} + +static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2) +{ + return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2); +} + +static void *JimObjectHTKeyValDup(void *privdata, const void *val) +{ + Jim_IncrRefCount((Jim_Obj *)val); + return (void *)val; +} + +static void JimObjectHTKeyValDestructor(void *interp, void *val) +{ + Jim_DecrRefCount(interp, (Jim_Obj *)val); +} + +static const Jim_HashTableType JimDictHashTableType = { + JimObjectHTHashFunction, + JimObjectHTKeyValDup, + JimObjectHTKeyValDup, + JimObjectHTKeyCompare, + JimObjectHTKeyValDestructor, + JimObjectHTKeyValDestructor +}; + +static const Jim_ObjType dictObjType = { + "dict", + FreeDictInternalRep, + DupDictInternalRep, + UpdateStringOfDict, + JIM_TYPE_NONE, +}; + +void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + JIM_NOTUSED(interp); + + Jim_FreeHashTable(objPtr->internalRep.ptr); + Jim_Free(objPtr->internalRep.ptr); +} + +void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + Jim_HashTable *ht, *dupHt; + Jim_HashTableIterator htiter; + Jim_HashEntry *he; + + + ht = srcPtr->internalRep.ptr; + dupHt = Jim_Alloc(sizeof(*dupHt)); + Jim_InitHashTable(dupHt, &JimDictHashTableType, interp); + if (ht->size != 0) + Jim_ExpandHashTable(dupHt, ht->size); + + JimInitHashTableIterator(ht, &htiter); + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + Jim_AddHashEntry(dupHt, he->key, he->u.val); + } + + dupPtr->internalRep.ptr = dupHt; + dupPtr->typePtr = &dictObjType; +} + +static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len) +{ + Jim_HashTable *ht; + Jim_HashTableIterator htiter; + Jim_HashEntry *he; + Jim_Obj **objv; + int i; + + ht = dictPtr->internalRep.ptr; + + + objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *)); + JimInitHashTableIterator(ht, &htiter); + i = 0; + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + objv[i++] = Jim_GetHashEntryKey(he); + objv[i++] = Jim_GetHashEntryVal(he); + } + *len = i; + return objv; +} + +static void UpdateStringOfDict(struct Jim_Obj *objPtr) +{ + + int len; + Jim_Obj **objv = JimDictPairs(objPtr, &len); + + + JimMakeListStringRep(objPtr, objv, len); + + Jim_Free(objv); +} + +static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + int listlen; + + if (objPtr->typePtr == &dictObjType) { + return JIM_OK; + } + + if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) { + Jim_String(objPtr); + } + + + listlen = Jim_ListLength(interp, objPtr); + if (listlen % 2) { + Jim_SetResultString(interp, "missing value to go with key", -1); + return JIM_ERR; + } + else { + + Jim_HashTable *ht; + int i; + + ht = Jim_Alloc(sizeof(*ht)); + Jim_InitHashTable(ht, &JimDictHashTableType, interp); + + for (i = 0; i < listlen; i += 2) { + Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i); + Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1); + + Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr); + } + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &dictObjType; + objPtr->internalRep.ptr = ht; + + return JIM_OK; + } +} + + + +static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr) +{ + Jim_HashTable *ht = objPtr->internalRep.ptr; + + if (valueObjPtr == NULL) { + return Jim_DeleteHashEntry(ht, keyObjPtr); + } + Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr); + return JIM_OK; +} + +int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr) +{ + JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object")); + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return JIM_ERR; + } + Jim_InvalidateStringRep(objPtr); + return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr); +} + +Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len) +{ + Jim_Obj *objPtr; + int i; + + JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even")); + + objPtr = Jim_NewObj(interp); + objPtr->typePtr = &dictObjType; + objPtr->bytes = NULL; + objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable)); + Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp); + for (i = 0; i < len; i += 2) + DictAddElement(interp, objPtr, elements[i], elements[i + 1]); + return objPtr; +} + +int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr, + Jim_Obj **objPtrPtr, int flags) +{ + Jim_HashEntry *he; + Jim_HashTable *ht; + + if (SetDictFromAny(interp, dictPtr) != JIM_OK) { + return -1; + } + ht = dictPtr->internalRep.ptr; + if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) { + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr); + } + return JIM_ERR; + } + else { + *objPtrPtr = Jim_GetHashEntryVal(he); + return JIM_OK; + } +} + + +int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len) +{ + if (SetDictFromAny(interp, dictPtr) != JIM_OK) { + return JIM_ERR; + } + *objPtrPtr = JimDictPairs(dictPtr, len); + + return JIM_OK; +} + + + +int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr, + Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags) +{ + int i; + + if (keyc == 0) { + *objPtrPtr = dictPtr; + return JIM_OK; + } + + for (i = 0; i < keyc; i++) { + Jim_Obj *objPtr; + + int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags); + if (rc != JIM_OK) { + return rc; + } + dictPtr = objPtr; + } + *objPtrPtr = dictPtr; + return JIM_OK; +} + +int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr, + Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags) +{ + Jim_Obj *varObjPtr, *objPtr, *dictObjPtr; + int shared, i; + + varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags); + if (objPtr == NULL) { + if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) { + + return JIM_ERR; + } + varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0); + if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) { + Jim_FreeNewObj(interp, varObjPtr); + return JIM_ERR; + } + } + if ((shared = Jim_IsShared(objPtr))) + varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr); + for (i = 0; i < keyc; i++) { + dictObjPtr = objPtr; + + + if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) { + goto err; + } + + if (i == keyc - 1) { + + if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) { + if (newObjPtr || (flags & JIM_MUSTEXIST)) { + goto err; + } + } + break; + } + + + Jim_InvalidateStringRep(dictObjPtr); + if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr, + newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) { + if (Jim_IsShared(objPtr)) { + objPtr = Jim_DuplicateObj(interp, objPtr); + DictAddElement(interp, dictObjPtr, keyv[i], objPtr); + } + } + else { + if (newObjPtr == NULL) { + goto err; + } + objPtr = Jim_NewDictObj(interp, NULL, 0); + DictAddElement(interp, dictObjPtr, keyv[i], objPtr); + } + } + + Jim_InvalidateStringRep(objPtr); + Jim_InvalidateStringRep(varObjPtr); + if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) { + goto err; + } + Jim_SetResult(interp, varObjPtr); + return JIM_OK; + err: + if (shared) { + Jim_FreeNewObj(interp, varObjPtr); + } + return JIM_ERR; +} + +static void UpdateStringOfIndex(struct Jim_Obj *objPtr); +static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType indexObjType = { + "index", + NULL, + NULL, + UpdateStringOfIndex, + JIM_TYPE_NONE, +}; + +static void UpdateStringOfIndex(struct Jim_Obj *objPtr) +{ + if (objPtr->internalRep.intValue == -1) { + JimSetStringBytes(objPtr, "end"); + } + else { + char buf[JIM_INTEGER_SPACE + 1]; + if (objPtr->internalRep.intValue >= 0) { + sprintf(buf, "%d", objPtr->internalRep.intValue); + } + else { + + sprintf(buf, "end%d", objPtr->internalRep.intValue + 1); + } + JimSetStringBytes(objPtr, buf); + } +} + +static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + int idx, end = 0; + const char *str; + char *endptr; + + + str = Jim_String(objPtr); + + + if (strncmp(str, "end", 3) == 0) { + end = 1; + str += 3; + idx = 0; + } + else { + idx = jim_strtol(str, &endptr); + + if (endptr == str) { + goto badindex; + } + str = endptr; + } + + + if (*str == '+' || *str == '-') { + int sign = (*str == '+' ? 1 : -1); + + idx += sign * jim_strtol(++str, &endptr); + if (str == endptr || *endptr) { + goto badindex; + } + str = endptr; + } + + while (isspace(UCHAR(*str))) { + str++; + } + if (*str) { + goto badindex; + } + if (end) { + if (idx > 0) { + idx = INT_MAX; + } + else { + + idx--; + } + } + else if (idx < 0) { + idx = -INT_MAX; + } + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &indexObjType; + objPtr->internalRep.intValue = idx; + return JIM_OK; + + badindex: + Jim_SetResultFormatted(interp, + "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr); + return JIM_ERR; +} + +int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr) +{ + + if (objPtr->typePtr == &intObjType) { + jim_wide val = JimWideValue(objPtr); + + if (val < 0) + *indexPtr = -INT_MAX; + else if (val > INT_MAX) + *indexPtr = INT_MAX; + else + *indexPtr = (int)val; + return JIM_OK; + } + if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR) + return JIM_ERR; + *indexPtr = objPtr->internalRep.intValue; + return JIM_OK; +} + + + +static const char * const jimReturnCodes[] = { + "ok", + "error", + "return", + "break", + "continue", + "signal", + "exit", + "eval", + NULL +}; + +#define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes) - 1) + +static const Jim_ObjType returnCodeObjType = { + "return-code", + NULL, + NULL, + NULL, + JIM_TYPE_NONE, +}; + +const char *Jim_ReturnCode(int code) +{ + if (code < 0 || code >= (int)jimReturnCodesSize) { + return "?"; + } + else { + return jimReturnCodes[code]; + } +} + +static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + int returnCode; + jim_wide wideValue; + + + if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR) + returnCode = (int)wideValue; + else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) { + Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr); + return JIM_ERR; + } + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &returnCodeObjType; + objPtr->internalRep.intValue = returnCode; + return JIM_OK; +} + +int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr) +{ + if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR) + return JIM_ERR; + *intPtr = objPtr->internalRep.intValue; + return JIM_OK; +} + +static int JimParseExprOperator(struct JimParserCtx *pc); +static int JimParseExprNumber(struct JimParserCtx *pc); +static int JimParseExprIrrational(struct JimParserCtx *pc); +static int JimParseExprBoolean(struct JimParserCtx *pc); + + +enum +{ + + + + JIM_EXPROP_MUL = JIM_TT_EXPR_OP, + JIM_EXPROP_DIV, + JIM_EXPROP_MOD, + JIM_EXPROP_SUB, + JIM_EXPROP_ADD, + JIM_EXPROP_LSHIFT, + JIM_EXPROP_RSHIFT, + JIM_EXPROP_ROTL, + JIM_EXPROP_ROTR, + JIM_EXPROP_LT, + JIM_EXPROP_GT, + JIM_EXPROP_LTE, + JIM_EXPROP_GTE, + JIM_EXPROP_NUMEQ, + JIM_EXPROP_NUMNE, + JIM_EXPROP_BITAND, + JIM_EXPROP_BITXOR, + JIM_EXPROP_BITOR, + JIM_EXPROP_LOGICAND, + JIM_EXPROP_LOGICOR, + JIM_EXPROP_TERNARY, + JIM_EXPROP_COLON, + JIM_EXPROP_POW, + + + JIM_EXPROP_STREQ, + JIM_EXPROP_STRNE, + JIM_EXPROP_STRIN, + JIM_EXPROP_STRNI, + + + JIM_EXPROP_NOT, + JIM_EXPROP_BITNOT, + JIM_EXPROP_UNARYMINUS, + JIM_EXPROP_UNARYPLUS, + + + JIM_EXPROP_FUNC_INT, + JIM_EXPROP_FUNC_WIDE, + JIM_EXPROP_FUNC_ABS, + JIM_EXPROP_FUNC_DOUBLE, + JIM_EXPROP_FUNC_ROUND, + JIM_EXPROP_FUNC_RAND, + JIM_EXPROP_FUNC_SRAND, + + + JIM_EXPROP_FUNC_SIN, + JIM_EXPROP_FUNC_COS, + JIM_EXPROP_FUNC_TAN, + JIM_EXPROP_FUNC_ASIN, + JIM_EXPROP_FUNC_ACOS, + JIM_EXPROP_FUNC_ATAN, + JIM_EXPROP_FUNC_ATAN2, + JIM_EXPROP_FUNC_SINH, + JIM_EXPROP_FUNC_COSH, + JIM_EXPROP_FUNC_TANH, + JIM_EXPROP_FUNC_CEIL, + JIM_EXPROP_FUNC_FLOOR, + JIM_EXPROP_FUNC_EXP, + JIM_EXPROP_FUNC_LOG, + JIM_EXPROP_FUNC_LOG10, + JIM_EXPROP_FUNC_SQRT, + JIM_EXPROP_FUNC_POW, + JIM_EXPROP_FUNC_HYPOT, + JIM_EXPROP_FUNC_FMOD, +}; + +struct JimExprNode { + int type; + struct Jim_Obj *objPtr; + + struct JimExprNode *left; + struct JimExprNode *right; + struct JimExprNode *ternary; +}; + + +typedef struct Jim_ExprOperator +{ + const char *name; + int (*funcop) (Jim_Interp *interp, struct JimExprNode *opnode); + unsigned char precedence; + unsigned char arity; + unsigned char attr; + unsigned char namelen; +} Jim_ExprOperator; + +static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr); +static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node); +static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node); + +static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node) +{ + int intresult = 1; + int rc; + double dA, dC = 0; + jim_wide wA, wC = 0; + Jim_Obj *A; + + if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) { + return rc; + } + + if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) { + switch (node->type) { + case JIM_EXPROP_FUNC_INT: + case JIM_EXPROP_FUNC_WIDE: + case JIM_EXPROP_FUNC_ROUND: + case JIM_EXPROP_UNARYPLUS: + wC = wA; + break; + case JIM_EXPROP_FUNC_DOUBLE: + dC = wA; + intresult = 0; + break; + case JIM_EXPROP_FUNC_ABS: + wC = wA >= 0 ? wA : -wA; + break; + case JIM_EXPROP_UNARYMINUS: + wC = -wA; + break; + case JIM_EXPROP_NOT: + wC = !wA; + break; + default: + abort(); + } + } + else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) { + switch (node->type) { + case JIM_EXPROP_FUNC_INT: + case JIM_EXPROP_FUNC_WIDE: + wC = dA; + break; + case JIM_EXPROP_FUNC_ROUND: + wC = dA < 0 ? (dA - 0.5) : (dA + 0.5); + break; + case JIM_EXPROP_FUNC_DOUBLE: + case JIM_EXPROP_UNARYPLUS: + dC = dA; + intresult = 0; + break; + case JIM_EXPROP_FUNC_ABS: +#ifdef JIM_MATH_FUNCTIONS + dC = fabs(dA); +#else + dC = dA >= 0 ? dA : -dA; +#endif + intresult = 0; + break; + case JIM_EXPROP_UNARYMINUS: + dC = -dA; + intresult = 0; + break; + case JIM_EXPROP_NOT: + wC = !dA; + break; + default: + abort(); + } + } + + if (rc == JIM_OK) { + if (intresult) { + Jim_SetResultInt(interp, wC); + } + else { + Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC)); + } + } + + Jim_DecrRefCount(interp, A); + + return rc; +} + +static double JimRandDouble(Jim_Interp *interp) +{ + unsigned long x; + JimRandomBytes(interp, &x, sizeof(x)); + + return (double)x / (unsigned long)~0; +} + +static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node) +{ + jim_wide wA; + Jim_Obj *A; + int rc; + + if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) { + return rc; + } + + rc = Jim_GetWide(interp, A, &wA); + if (rc == JIM_OK) { + switch (node->type) { + case JIM_EXPROP_BITNOT: + Jim_SetResultInt(interp, ~wA); + break; + case JIM_EXPROP_FUNC_SRAND: + JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA)); + Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp))); + break; + default: + abort(); + } + } + + Jim_DecrRefCount(interp, A); + + return rc; +} + +static int JimExprOpNone(Jim_Interp *interp, struct JimExprNode *node) +{ + JimPanic((node->type != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()")); + + Jim_SetResult(interp, Jim_NewDoubleObj(interp, JimRandDouble(interp))); + + return JIM_OK; +} + +#ifdef JIM_MATH_FUNCTIONS +static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprNode *node) +{ + int rc; + double dA, dC; + Jim_Obj *A; + + if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) { + return rc; + } + + rc = Jim_GetDouble(interp, A, &dA); + if (rc == JIM_OK) { + switch (node->type) { + case JIM_EXPROP_FUNC_SIN: + dC = sin(dA); + break; + case JIM_EXPROP_FUNC_COS: + dC = cos(dA); + break; + case JIM_EXPROP_FUNC_TAN: + dC = tan(dA); + break; + case JIM_EXPROP_FUNC_ASIN: + dC = asin(dA); + break; + case JIM_EXPROP_FUNC_ACOS: + dC = acos(dA); + break; + case JIM_EXPROP_FUNC_ATAN: + dC = atan(dA); + break; + case JIM_EXPROP_FUNC_SINH: + dC = sinh(dA); + break; + case JIM_EXPROP_FUNC_COSH: + dC = cosh(dA); + break; + case JIM_EXPROP_FUNC_TANH: + dC = tanh(dA); + break; + case JIM_EXPROP_FUNC_CEIL: + dC = ceil(dA); + break; + case JIM_EXPROP_FUNC_FLOOR: + dC = floor(dA); + break; + case JIM_EXPROP_FUNC_EXP: + dC = exp(dA); + break; + case JIM_EXPROP_FUNC_LOG: + dC = log(dA); + break; + case JIM_EXPROP_FUNC_LOG10: + dC = log10(dA); + break; + case JIM_EXPROP_FUNC_SQRT: + dC = sqrt(dA); + break; + default: + abort(); + } + Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC)); + } + + Jim_DecrRefCount(interp, A); + + return rc; +} +#endif + + +static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprNode *node) +{ + jim_wide wA, wB; + int rc; + Jim_Obj *A, *B; + + if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) { + return rc; + } + if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) { + Jim_DecrRefCount(interp, A); + return rc; + } + + rc = JIM_ERR; + + if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) { + jim_wide wC; + + rc = JIM_OK; + + switch (node->type) { + case JIM_EXPROP_LSHIFT: + wC = wA << wB; + break; + case JIM_EXPROP_RSHIFT: + wC = wA >> wB; + break; + case JIM_EXPROP_BITAND: + wC = wA & wB; + break; + case JIM_EXPROP_BITXOR: + wC = wA ^ wB; + break; + case JIM_EXPROP_BITOR: + wC = wA | wB; + break; + case JIM_EXPROP_MOD: + if (wB == 0) { + wC = 0; + Jim_SetResultString(interp, "Division by zero", -1); + rc = JIM_ERR; + } + else { + int negative = 0; + + if (wB < 0) { + wB = -wB; + wA = -wA; + negative = 1; + } + wC = wA % wB; + if (wC < 0) { + wC += wB; + } + if (negative) { + wC = -wC; + } + } + break; + case JIM_EXPROP_ROTL: + case JIM_EXPROP_ROTR:{ + + unsigned long uA = (unsigned long)wA; + unsigned long uB = (unsigned long)wB; + const unsigned int S = sizeof(unsigned long) * 8; + + + uB %= S; + + if (node->type == JIM_EXPROP_ROTR) { + uB = S - uB; + } + wC = (unsigned long)(uA << uB) | (uA >> (S - uB)); + break; + } + default: + abort(); + } + Jim_SetResultInt(interp, wC); + } + + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, B); + + return rc; +} + + + +static int JimExprOpBin(Jim_Interp *interp, struct JimExprNode *node) +{ + int rc = JIM_OK; + double dA, dB, dC = 0; + jim_wide wA, wB, wC = 0; + Jim_Obj *A, *B; + + if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) { + return rc; + } + if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) { + Jim_DecrRefCount(interp, A); + return rc; + } + + if ((A->typePtr != &doubleObjType || A->bytes) && + (B->typePtr != &doubleObjType || B->bytes) && + JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) { + + + + switch (node->type) { + case JIM_EXPROP_POW: + case JIM_EXPROP_FUNC_POW: + if (wA == 0 && wB < 0) { + Jim_SetResultString(interp, "exponentiation of zero by negative power", -1); + rc = JIM_ERR; + goto done; + } + wC = JimPowWide(wA, wB); + goto intresult; + case JIM_EXPROP_ADD: + wC = wA + wB; + goto intresult; + case JIM_EXPROP_SUB: + wC = wA - wB; + goto intresult; + case JIM_EXPROP_MUL: + wC = wA * wB; + goto intresult; + case JIM_EXPROP_DIV: + if (wB == 0) { + Jim_SetResultString(interp, "Division by zero", -1); + rc = JIM_ERR; + goto done; + } + else { + if (wB < 0) { + wB = -wB; + wA = -wA; + } + wC = wA / wB; + if (wA % wB < 0) { + wC--; + } + goto intresult; + } + case JIM_EXPROP_LT: + wC = wA < wB; + goto intresult; + case JIM_EXPROP_GT: + wC = wA > wB; + goto intresult; + case JIM_EXPROP_LTE: + wC = wA <= wB; + goto intresult; + case JIM_EXPROP_GTE: + wC = wA >= wB; + goto intresult; + case JIM_EXPROP_NUMEQ: + wC = wA == wB; + goto intresult; + case JIM_EXPROP_NUMNE: + wC = wA != wB; + goto intresult; + } + } + if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) { + switch (node->type) { +#ifndef JIM_MATH_FUNCTIONS + case JIM_EXPROP_POW: + case JIM_EXPROP_FUNC_POW: + case JIM_EXPROP_FUNC_ATAN2: + case JIM_EXPROP_FUNC_HYPOT: + case JIM_EXPROP_FUNC_FMOD: + Jim_SetResultString(interp, "unsupported", -1); + rc = JIM_ERR; + goto done; +#else + case JIM_EXPROP_POW: + case JIM_EXPROP_FUNC_POW: + dC = pow(dA, dB); + goto doubleresult; + case JIM_EXPROP_FUNC_ATAN2: + dC = atan2(dA, dB); + goto doubleresult; + case JIM_EXPROP_FUNC_HYPOT: + dC = hypot(dA, dB); + goto doubleresult; + case JIM_EXPROP_FUNC_FMOD: + dC = fmod(dA, dB); + goto doubleresult; +#endif + case JIM_EXPROP_ADD: + dC = dA + dB; + goto doubleresult; + case JIM_EXPROP_SUB: + dC = dA - dB; + goto doubleresult; + case JIM_EXPROP_MUL: + dC = dA * dB; + goto doubleresult; + case JIM_EXPROP_DIV: + if (dB == 0) { +#ifdef INFINITY + dC = dA < 0 ? -INFINITY : INFINITY; +#else + dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL); +#endif + } + else { + dC = dA / dB; + } + goto doubleresult; + case JIM_EXPROP_LT: + wC = dA < dB; + goto intresult; + case JIM_EXPROP_GT: + wC = dA > dB; + goto intresult; + case JIM_EXPROP_LTE: + wC = dA <= dB; + goto intresult; + case JIM_EXPROP_GTE: + wC = dA >= dB; + goto intresult; + case JIM_EXPROP_NUMEQ: + wC = dA == dB; + goto intresult; + case JIM_EXPROP_NUMNE: + wC = dA != dB; + goto intresult; + } + } + else { + + + + int i = Jim_StringCompareObj(interp, A, B, 0); + + switch (node->type) { + case JIM_EXPROP_LT: + wC = i < 0; + goto intresult; + case JIM_EXPROP_GT: + wC = i > 0; + goto intresult; + case JIM_EXPROP_LTE: + wC = i <= 0; + goto intresult; + case JIM_EXPROP_GTE: + wC = i >= 0; + goto intresult; + case JIM_EXPROP_NUMEQ: + wC = i == 0; + goto intresult; + case JIM_EXPROP_NUMNE: + wC = i != 0; + goto intresult; + } + } + + rc = JIM_ERR; +done: + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, B); + return rc; +intresult: + Jim_SetResultInt(interp, wC); + goto done; +doubleresult: + Jim_SetResult(interp, Jim_NewDoubleObj(interp, dC)); + goto done; +} + +static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj) +{ + int listlen; + int i; + + listlen = Jim_ListLength(interp, listObjPtr); + for (i = 0; i < listlen; i++) { + if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) { + return 1; + } + } + return 0; +} + + + +static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node) +{ + Jim_Obj *A, *B; + jim_wide wC; + int rc; + + if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) { + return rc; + } + if ((rc = JimExprGetTerm(interp, node->right, &B)) != JIM_OK) { + Jim_DecrRefCount(interp, A); + return rc; + } + + switch (node->type) { + case JIM_EXPROP_STREQ: + case JIM_EXPROP_STRNE: + wC = Jim_StringEqObj(A, B); + if (node->type == JIM_EXPROP_STRNE) { + wC = !wC; + } + break; + case JIM_EXPROP_STRIN: + wC = JimSearchList(interp, B, A); + break; + case JIM_EXPROP_STRNI: + wC = !JimSearchList(interp, B, A); + break; + default: + abort(); + } + Jim_SetResultInt(interp, wC); + + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, B); + + return rc; +} + +static int ExprBool(Jim_Interp *interp, Jim_Obj *obj) +{ + long l; + double d; + int b; + int ret = -1; + + + Jim_IncrRefCount(obj); + + if (Jim_GetLong(interp, obj, &l) == JIM_OK) { + ret = (l != 0); + } + else if (Jim_GetDouble(interp, obj, &d) == JIM_OK) { + ret = (d != 0); + } + else if (Jim_GetBoolean(interp, obj, &b) == JIM_OK) { + ret = (b != 0); + } + + Jim_DecrRefCount(interp, obj); + return ret; +} + +static int JimExprOpAnd(Jim_Interp *interp, struct JimExprNode *node) +{ + + int result = JimExprGetTermBoolean(interp, node->left); + + if (result == 1) { + + result = JimExprGetTermBoolean(interp, node->right); + } + if (result == -1) { + return JIM_ERR; + } + Jim_SetResultInt(interp, result); + return JIM_OK; +} + +static int JimExprOpOr(Jim_Interp *interp, struct JimExprNode *node) +{ + + int result = JimExprGetTermBoolean(interp, node->left); + + if (result == 0) { + + result = JimExprGetTermBoolean(interp, node->right); + } + if (result == -1) { + return JIM_ERR; + } + Jim_SetResultInt(interp, result); + return JIM_OK; +} + +static int JimExprOpTernary(Jim_Interp *interp, struct JimExprNode *node) +{ + + int result = JimExprGetTermBoolean(interp, node->left); + + if (result == 1) { + + return JimExprEvalTermNode(interp, node->right); + } + else if (result == 0) { + + return JimExprEvalTermNode(interp, node->ternary); + } + + return JIM_ERR; +} + +enum +{ + OP_FUNC = 0x0001, + OP_RIGHT_ASSOC = 0x0002, +}; + +#define OPRINIT_ATTR(N, P, ARITY, F, ATTR) {N, F, P, ARITY, ATTR, sizeof(N) - 1} +#define OPRINIT(N, P, ARITY, F) OPRINIT_ATTR(N, P, ARITY, F, 0) + +static const struct Jim_ExprOperator Jim_ExprOperators[] = { + OPRINIT("*", 110, 2, JimExprOpBin), + OPRINIT("/", 110, 2, JimExprOpBin), + OPRINIT("%", 110, 2, JimExprOpIntBin), + + OPRINIT("-", 100, 2, JimExprOpBin), + OPRINIT("+", 100, 2, JimExprOpBin), + + OPRINIT("<<", 90, 2, JimExprOpIntBin), + OPRINIT(">>", 90, 2, JimExprOpIntBin), + + OPRINIT("<<<", 90, 2, JimExprOpIntBin), + OPRINIT(">>>", 90, 2, JimExprOpIntBin), + + OPRINIT("<", 80, 2, JimExprOpBin), + OPRINIT(">", 80, 2, JimExprOpBin), + OPRINIT("<=", 80, 2, JimExprOpBin), + OPRINIT(">=", 80, 2, JimExprOpBin), + + OPRINIT("==", 70, 2, JimExprOpBin), + OPRINIT("!=", 70, 2, JimExprOpBin), + + OPRINIT("&", 50, 2, JimExprOpIntBin), + OPRINIT("^", 49, 2, JimExprOpIntBin), + OPRINIT("|", 48, 2, JimExprOpIntBin), + + OPRINIT("&&", 10, 2, JimExprOpAnd), + OPRINIT("||", 9, 2, JimExprOpOr), + OPRINIT_ATTR("?", 5, 3, JimExprOpTernary, OP_RIGHT_ASSOC), + OPRINIT_ATTR(":", 5, 3, NULL, OP_RIGHT_ASSOC), + + + OPRINIT_ATTR("**", 120, 2, JimExprOpBin, OP_RIGHT_ASSOC), + + OPRINIT("eq", 60, 2, JimExprOpStrBin), + OPRINIT("ne", 60, 2, JimExprOpStrBin), + + OPRINIT("in", 55, 2, JimExprOpStrBin), + OPRINIT("ni", 55, 2, JimExprOpStrBin), + + OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC), + OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC), + OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC), + OPRINIT_ATTR(" +", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC), + + + + OPRINIT_ATTR("int", 200, 1, JimExprOpNumUnary, OP_FUNC), + OPRINIT_ATTR("wide", 200, 1, JimExprOpNumUnary, OP_FUNC), + OPRINIT_ATTR("abs", 200, 1, JimExprOpNumUnary, OP_FUNC), + OPRINIT_ATTR("double", 200, 1, JimExprOpNumUnary, OP_FUNC), + OPRINIT_ATTR("round", 200, 1, JimExprOpNumUnary, OP_FUNC), + OPRINIT_ATTR("rand", 200, 0, JimExprOpNone, OP_FUNC), + OPRINIT_ATTR("srand", 200, 1, JimExprOpIntUnary, OP_FUNC), + +#ifdef JIM_MATH_FUNCTIONS + OPRINIT_ATTR("sin", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("cos", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("tan", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("asin", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("acos", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("atan", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("atan2", 200, 2, JimExprOpBin, OP_FUNC), + OPRINIT_ATTR("sinh", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("cosh", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("tanh", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("ceil", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("floor", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("exp", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("log", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("log10", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("sqrt", 200, 1, JimExprOpDoubleUnary, OP_FUNC), + OPRINIT_ATTR("pow", 200, 2, JimExprOpBin, OP_FUNC), + OPRINIT_ATTR("hypot", 200, 2, JimExprOpBin, OP_FUNC), + OPRINIT_ATTR("fmod", 200, 2, JimExprOpBin, OP_FUNC), +#endif +}; +#undef OPRINIT +#undef OPRINIT_ATTR + +#define JIM_EXPR_OPERATORS_NUM \ + (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator)) + +static int JimParseExpression(struct JimParserCtx *pc) +{ + + while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) { + if (*pc->p == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; + } + + + pc->tline = pc->linenr; + pc->tstart = pc->p; + + if (pc->len == 0) { + pc->tend = pc->p; + pc->tt = JIM_TT_EOL; + pc->eof = 1; + return JIM_OK; + } + switch (*(pc->p)) { + case '(': + pc->tt = JIM_TT_SUBEXPR_START; + goto singlechar; + case ')': + pc->tt = JIM_TT_SUBEXPR_END; + goto singlechar; + case ',': + pc->tt = JIM_TT_SUBEXPR_COMMA; +singlechar: + pc->tend = pc->p; + pc->p++; + pc->len--; + break; + case '[': + return JimParseCmd(pc); + case '$': + if (JimParseVar(pc) == JIM_ERR) + return JimParseExprOperator(pc); + else { + + if (pc->tt == JIM_TT_EXPRSUGAR) { + return JIM_ERR; + } + return JIM_OK; + } + break; + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + case '.': + return JimParseExprNumber(pc); + case '"': + return JimParseQuote(pc); + case '{': + return JimParseBrace(pc); + + case 'N': + case 'I': + case 'n': + case 'i': + if (JimParseExprIrrational(pc) == JIM_ERR) + if (JimParseExprBoolean(pc) == JIM_ERR) + return JimParseExprOperator(pc); + break; + case 't': + case 'f': + case 'o': + case 'y': + if (JimParseExprBoolean(pc) == JIM_ERR) + return JimParseExprOperator(pc); + break; + default: + return JimParseExprOperator(pc); + break; + } + return JIM_OK; +} + +static int JimParseExprNumber(struct JimParserCtx *pc) +{ + char *end; + + + pc->tt = JIM_TT_EXPR_INT; + + jim_strtoull(pc->p, (char **)&pc->p); + + if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) { + if (strtod(pc->tstart, &end)) { } + if (end == pc->tstart) + return JIM_ERR; + if (end > pc->p) { + + pc->tt = JIM_TT_EXPR_DOUBLE; + pc->p = end; + } + } + pc->tend = pc->p - 1; + pc->len -= (pc->p - pc->tstart); + return JIM_OK; +} + +static int JimParseExprIrrational(struct JimParserCtx *pc) +{ + const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL }; + int i; + + for (i = 0; irrationals[i]; i++) { + const char *irr = irrationals[i]; + + if (strncmp(irr, pc->p, 3) == 0) { + pc->p += 3; + pc->len -= 3; + pc->tend = pc->p - 1; + pc->tt = JIM_TT_EXPR_DOUBLE; + return JIM_OK; + } + } + return JIM_ERR; +} + +static int JimParseExprBoolean(struct JimParserCtx *pc) +{ + const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL }; + const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 }; + int i; + + for (i = 0; booleans[i]; i++) { + const char *boolean = booleans[i]; + int length = lengths[i]; + + if (strncmp(boolean, pc->p, length) == 0) { + pc->p += length; + pc->len -= length; + pc->tend = pc->p - 1; + pc->tt = JIM_TT_EXPR_BOOLEAN; + return JIM_OK; + } + } + return JIM_ERR; +} + +static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode) +{ + static Jim_ExprOperator dummy_op; + if (opcode < JIM_TT_EXPR_OP) { + return &dummy_op; + } + return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP]; +} + +static int JimParseExprOperator(struct JimParserCtx *pc) +{ + int i; + const struct Jim_ExprOperator *bestOp = NULL; + int bestLen = 0; + + + for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) { + const struct Jim_ExprOperator *op = &Jim_ExprOperators[i]; + + if (op->name[0] != pc->p[0]) { + continue; + } + + if (op->namelen > bestLen && strncmp(op->name, pc->p, op->namelen) == 0) { + bestOp = op; + bestLen = op->namelen; + } + } + if (bestOp == NULL) { + return JIM_ERR; + } + + + if (bestOp->attr & OP_FUNC) { + const char *p = pc->p + bestLen; + int len = pc->len - bestLen; + + while (len && isspace(UCHAR(*p))) { + len--; + p++; + } + if (*p != '(') { + return JIM_ERR; + } + } + pc->tend = pc->p + bestLen - 1; + pc->p += bestLen; + pc->len -= bestLen; + + pc->tt = (bestOp - Jim_ExprOperators) + JIM_TT_EXPR_OP; + return JIM_OK; +} + +const char *jim_tt_name(int type) +{ + static const char * const tt_names[JIM_TT_EXPR_OP] = + { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT", + "DBL", "BOO", "$()" }; + if (type < JIM_TT_EXPR_OP) { + return tt_names[type]; + } + else if (type == JIM_EXPROP_UNARYMINUS) { + return "-VE"; + } + else if (type == JIM_EXPROP_UNARYPLUS) { + return "+VE"; + } + else { + const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type); + static char buf[20]; + + if (op->name) { + return op->name; + } + sprintf(buf, "(%d)", type); + return buf; + } +} + +static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType exprObjType = { + "expression", + FreeExprInternalRep, + DupExprInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + + +struct ExprTree +{ + struct JimExprNode *expr; + struct JimExprNode *nodes; + int len; + int inUse; +}; + +static void ExprTreeFreeNodes(Jim_Interp *interp, struct JimExprNode *nodes, int num) +{ + int i; + for (i = 0; i < num; i++) { + if (nodes[i].objPtr) { + Jim_DecrRefCount(interp, nodes[i].objPtr); + } + } + Jim_Free(nodes); +} + +static void ExprTreeFree(Jim_Interp *interp, struct ExprTree *expr) +{ + ExprTreeFreeNodes(interp, expr->nodes, expr->len); + Jim_Free(expr); +} + +static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + struct ExprTree *expr = (void *)objPtr->internalRep.ptr; + + if (expr) { + if (--expr->inUse != 0) { + return; + } + + ExprTreeFree(interp, expr); + } +} + +static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + JIM_NOTUSED(interp); + JIM_NOTUSED(srcPtr); + + + dupPtr->typePtr = NULL; +} + +struct ExprBuilder { + int parencount; + int level; + ParseToken *token; + ParseToken *first_token; + Jim_Stack stack; + Jim_Obj *exprObjPtr; + Jim_Obj *fileNameObj; + struct JimExprNode *nodes; + struct JimExprNode *next; +}; + +#ifdef DEBUG_SHOW_EXPR +static void JimShowExprNode(struct JimExprNode *node, int level) +{ + int i; + for (i = 0; i < level; i++) { + printf(" "); + } + if (TOKEN_IS_EXPR_OP(node->type)) { + printf("%s\n", jim_tt_name(node->type)); + if (node->left) { + JimShowExprNode(node->left, level + 1); + } + if (node->right) { + JimShowExprNode(node->right, level + 1); + } + if (node->ternary) { + JimShowExprNode(node->ternary, level + 1); + } + } + else { + printf("[%s] %s\n", jim_tt_name(node->type), Jim_String(node->objPtr)); + } +} +#endif + +#define EXPR_UNTIL_CLOSE 0x0001 +#define EXPR_FUNC_ARGS 0x0002 +#define EXPR_TERNARY 0x0004 + +static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms) +{ + int rc; + struct JimExprNode *node; + + int exp_stacklen = builder->stack.len + exp_numterms; + + if (builder->level++ > 200) { + Jim_SetResultString(interp, "Expression too complex", -1); + return JIM_ERR; + } + + while (builder->token->type != JIM_TT_EOL) { + ParseToken *t = builder->token++; + int prevtt; + + if (t == builder->first_token) { + prevtt = JIM_TT_NONE; + } + else { + prevtt = t[-1].type; + } + + if (t->type == JIM_TT_SUBEXPR_START) { + if (builder->stack.len == exp_stacklen) { + Jim_SetResultFormatted(interp, "unexpected open parenthesis in expression: \"%#s\"", builder->exprObjPtr); + return JIM_ERR; + } + builder->parencount++; + rc = ExprTreeBuildTree(interp, builder, 0, EXPR_UNTIL_CLOSE, 1); + if (rc != JIM_OK) { + return rc; + } + + } + else if (t->type == JIM_TT_SUBEXPR_END) { + if (!(flags & EXPR_UNTIL_CLOSE)) { + if (builder->stack.len == exp_stacklen && builder->level > 1) { + builder->token--; + builder->level--; + return JIM_OK; + } + Jim_SetResultFormatted(interp, "unexpected closing parenthesis in expression: \"%#s\"", builder->exprObjPtr); + return JIM_ERR; + } + builder->parencount--; + if (builder->stack.len == exp_stacklen) { + + break; + } + } + else if (t->type == JIM_TT_SUBEXPR_COMMA) { + if (!(flags & EXPR_FUNC_ARGS)) { + if (builder->stack.len == exp_stacklen) { + + builder->token--; + builder->level--; + return JIM_OK; + } + Jim_SetResultFormatted(interp, "unexpected comma in expression: \"%#s\"", builder->exprObjPtr); + return JIM_ERR; + } + else { + + if (builder->stack.len > exp_stacklen) { + Jim_SetResultFormatted(interp, "too many arguments to math function"); + return JIM_ERR; + } + } + + } + else if (t->type == JIM_EXPROP_COLON) { + if (!(flags & EXPR_TERNARY)) { + if (builder->level != 1) { + + builder->token--; + builder->level--; + return JIM_OK; + } + Jim_SetResultFormatted(interp, ": without ? in expression: \"%#s\"", builder->exprObjPtr); + return JIM_ERR; + } + if (builder->stack.len == exp_stacklen) { + + builder->token--; + builder->level--; + return JIM_OK; + } + + } + else if (TOKEN_IS_EXPR_OP(t->type)) { + const struct Jim_ExprOperator *op; + + + if (TOKEN_IS_EXPR_OP(prevtt) || TOKEN_IS_EXPR_START(prevtt)) { + if (t->type == JIM_EXPROP_SUB) { + t->type = JIM_EXPROP_UNARYMINUS; + } + else if (t->type == JIM_EXPROP_ADD) { + t->type = JIM_EXPROP_UNARYPLUS; + } + } + + op = JimExprOperatorInfoByOpcode(t->type); + + if (op->precedence < precedence || (!(op->attr & OP_RIGHT_ASSOC) && op->precedence == precedence)) { + + builder->token--; + break; + } + + if (op->attr & OP_FUNC) { + if (builder->token->type != JIM_TT_SUBEXPR_START) { + Jim_SetResultString(interp, "missing arguments for math function", -1); + return JIM_ERR; + } + builder->token++; + if (op->arity == 0) { + if (builder->token->type != JIM_TT_SUBEXPR_END) { + Jim_SetResultString(interp, "too many arguments for math function", -1); + return JIM_ERR; + } + builder->token++; + goto noargs; + } + builder->parencount++; + + + rc = ExprTreeBuildTree(interp, builder, 0, EXPR_FUNC_ARGS | EXPR_UNTIL_CLOSE, op->arity); + } + else if (t->type == JIM_EXPROP_TERNARY) { + + rc = ExprTreeBuildTree(interp, builder, op->precedence, EXPR_TERNARY, 2); + } + else { + rc = ExprTreeBuildTree(interp, builder, op->precedence, 0, 1); + } + + if (rc != JIM_OK) { + return rc; + } + +noargs: + node = builder->next++; + node->type = t->type; + + if (op->arity >= 3) { + node->ternary = Jim_StackPop(&builder->stack); + if (node->ternary == NULL) { + goto missingoperand; + } + } + if (op->arity >= 2) { + node->right = Jim_StackPop(&builder->stack); + if (node->right == NULL) { + goto missingoperand; + } + } + if (op->arity >= 1) { + node->left = Jim_StackPop(&builder->stack); + if (node->left == NULL) { +missingoperand: + Jim_SetResultFormatted(interp, "missing operand to %s in expression: \"%#s\"", op->name, builder->exprObjPtr); + builder->next--; + return JIM_ERR; + + } + } + + + Jim_StackPush(&builder->stack, node); + } + else { + Jim_Obj *objPtr = NULL; + + + + + if (!TOKEN_IS_EXPR_START(prevtt) && !TOKEN_IS_EXPR_OP(prevtt)) { + Jim_SetResultFormatted(interp, "missing operator in expression: \"%#s\"", builder->exprObjPtr); + return JIM_ERR; + } + + + if (t->type == JIM_TT_EXPR_INT || t->type == JIM_TT_EXPR_DOUBLE) { + char *endptr; + if (t->type == JIM_TT_EXPR_INT) { + objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr)); + } + else { + objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr)); + } + if (endptr != t->token + t->len) { + + Jim_FreeNewObj(interp, objPtr); + objPtr = NULL; + } + } + + if (!objPtr) { + + objPtr = Jim_NewStringObj(interp, t->token, t->len); + if (t->type == JIM_TT_CMD) { + + JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line); + } + } + + + node = builder->next++; + node->objPtr = objPtr; + Jim_IncrRefCount(node->objPtr); + node->type = t->type; + Jim_StackPush(&builder->stack, node); + } + } + + if (builder->stack.len == exp_stacklen) { + builder->level--; + return JIM_OK; + } + + if ((flags & EXPR_FUNC_ARGS)) { + Jim_SetResultFormatted(interp, "too %s arguments for math function", (builder->stack.len < exp_stacklen) ? "few" : "many"); + } + else { + if (builder->stack.len < exp_stacklen) { + if (builder->level == 0) { + Jim_SetResultFormatted(interp, "empty expression"); + } + else { + Jim_SetResultFormatted(interp, "syntax error in expression \"%#s\": premature end of expression", builder->exprObjPtr); + } + } + else { + Jim_SetResultFormatted(interp, "extra terms after expression"); + } + } + + return JIM_ERR; +} + +static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *exprObjPtr, Jim_Obj *fileNameObj) +{ + struct ExprTree *expr; + struct ExprBuilder builder; + int rc; + struct JimExprNode *top = NULL; + + builder.parencount = 0; + builder.level = 0; + builder.token = builder.first_token = tokenlist->list; + builder.exprObjPtr = exprObjPtr; + builder.fileNameObj = fileNameObj; + + builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1)); + memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1)); + builder.next = builder.nodes; + Jim_InitStack(&builder.stack); + + rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1); + + if (rc == JIM_OK) { + top = Jim_StackPop(&builder.stack); + + if (builder.parencount) { + Jim_SetResultString(interp, "missing close parenthesis", -1); + rc = JIM_ERR; + } + } + + + Jim_FreeStack(&builder.stack); + + if (rc != JIM_OK) { + ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes); + return NULL; + } + + expr = Jim_Alloc(sizeof(*expr)); + expr->inUse = 1; + expr->expr = top; + expr->nodes = builder.nodes; + expr->len = builder.next - builder.nodes; + + assert(expr->len <= tokenlist->count - 1); + + return expr; +} + +static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + int exprTextLen; + const char *exprText; + struct JimParserCtx parser; + struct ExprTree *expr; + ParseTokenList tokenlist; + int line; + Jim_Obj *fileNameObj; + int rc = JIM_ERR; + + + if (objPtr->typePtr == &sourceObjType) { + fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; + line = objPtr->internalRep.sourceValue.lineNumber; + } + else { + fileNameObj = interp->emptyObj; + line = 1; + } + Jim_IncrRefCount(fileNameObj); + + exprText = Jim_GetString(objPtr, &exprTextLen); + + + ScriptTokenListInit(&tokenlist); + + JimParserInit(&parser, exprText, exprTextLen, line); + while (!parser.eof) { + if (JimParseExpression(&parser) != JIM_OK) { + ScriptTokenListFree(&tokenlist); + Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr); + expr = NULL; + goto err; + } + + ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt, + parser.tline); + } + +#ifdef DEBUG_SHOW_EXPR_TOKENS + { + int i; + printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj)); + for (i = 0; i < tokenlist.count; i++) { + printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type), + tokenlist.list[i].len, tokenlist.list[i].token); + } + } +#endif + + if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) { + ScriptTokenListFree(&tokenlist); + Jim_DecrRefCount(interp, fileNameObj); + return JIM_ERR; + } + + + expr = ExprTreeCreateTree(interp, &tokenlist, objPtr, fileNameObj); + + + ScriptTokenListFree(&tokenlist); + + if (!expr) { + goto err; + } + +#ifdef DEBUG_SHOW_EXPR + printf("==== Expr ====\n"); + JimShowExprNode(expr->expr, 0); +#endif + + rc = JIM_OK; + + err: + + Jim_DecrRefCount(interp, fileNameObj); + Jim_FreeIntRep(interp, objPtr); + Jim_SetIntRepPtr(objPtr, expr); + objPtr->typePtr = &exprObjType; + return rc; +} + +static struct ExprTree *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr->typePtr != &exprObjType) { + if (SetExprFromAny(interp, objPtr) != JIM_OK) { + return NULL; + } + } + return (struct ExprTree *) Jim_GetIntRepPtr(objPtr); +} + +#ifdef JIM_OPTIMIZATION +static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, struct JimExprNode *node) +{ + if (node->type == JIM_TT_EXPR_INT) + return node->objPtr; + else if (node->type == JIM_TT_VAR) + return Jim_GetVariable(interp, node->objPtr, JIM_NONE); + else if (node->type == JIM_TT_DICTSUGAR) + return JimExpandDictSugar(interp, node->objPtr); + else + return NULL; +} +#endif + + +static int JimExprEvalTermNode(Jim_Interp *interp, struct JimExprNode *node) +{ + if (TOKEN_IS_EXPR_OP(node->type)) { + const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(node->type); + return op->funcop(interp, node); + } + else { + Jim_Obj *objPtr; + + + switch (node->type) { + case JIM_TT_EXPR_INT: + case JIM_TT_EXPR_DOUBLE: + case JIM_TT_EXPR_BOOLEAN: + case JIM_TT_STR: + Jim_SetResult(interp, node->objPtr); + return JIM_OK; + + case JIM_TT_VAR: + objPtr = Jim_GetVariable(interp, node->objPtr, JIM_ERRMSG); + if (objPtr) { + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + return JIM_ERR; + + case JIM_TT_DICTSUGAR: + objPtr = JimExpandDictSugar(interp, node->objPtr); + if (objPtr) { + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + return JIM_ERR; + + case JIM_TT_ESC: + if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) { + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + return JIM_ERR; + + case JIM_TT_CMD: + return Jim_EvalObj(interp, node->objPtr); + + default: + + return JIM_ERR; + } + } +} + +static int JimExprGetTerm(Jim_Interp *interp, struct JimExprNode *node, Jim_Obj **objPtrPtr) +{ + int rc = JimExprEvalTermNode(interp, node); + if (rc == JIM_OK) { + *objPtrPtr = Jim_GetResult(interp); + Jim_IncrRefCount(*objPtrPtr); + } + return rc; +} + +static int JimExprGetTermBoolean(Jim_Interp *interp, struct JimExprNode *node) +{ + if (JimExprEvalTermNode(interp, node) == JIM_OK) { + return ExprBool(interp, Jim_GetResult(interp)); + } + return -1; +} + +int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr) +{ + struct ExprTree *expr; + int retcode = JIM_OK; + + expr = JimGetExpression(interp, exprObjPtr); + if (!expr) { + return JIM_ERR; + } + +#ifdef JIM_OPTIMIZATION + { + Jim_Obj *objPtr; + + + switch (expr->len) { + case 1: + objPtr = JimExprIntValOrVar(interp, expr->expr); + if (objPtr) { + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + break; + + case 2: + if (expr->expr->type == JIM_EXPROP_NOT) { + objPtr = JimExprIntValOrVar(interp, expr->expr->left); + + if (objPtr && JimIsWide(objPtr)) { + Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj); + return JIM_OK; + } + } + break; + + case 3: + objPtr = JimExprIntValOrVar(interp, expr->expr->left); + if (objPtr && JimIsWide(objPtr)) { + Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, expr->expr->right); + if (objPtr2 && JimIsWide(objPtr2)) { + jim_wide wideValueA = JimWideValue(objPtr); + jim_wide wideValueB = JimWideValue(objPtr2); + int cmpRes; + switch (expr->expr->type) { + case JIM_EXPROP_LT: + cmpRes = wideValueA < wideValueB; + break; + case JIM_EXPROP_LTE: + cmpRes = wideValueA <= wideValueB; + break; + case JIM_EXPROP_GT: + cmpRes = wideValueA > wideValueB; + break; + case JIM_EXPROP_GTE: + cmpRes = wideValueA >= wideValueB; + break; + case JIM_EXPROP_NUMEQ: + cmpRes = wideValueA == wideValueB; + break; + case JIM_EXPROP_NUMNE: + cmpRes = wideValueA != wideValueB; + break; + default: + goto noopt; + } + Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj); + return JIM_OK; + } + } + break; + } + } +noopt: +#endif + + expr->inUse++; + + + retcode = JimExprEvalTermNode(interp, expr->expr); + + expr->inUse--; + + return retcode; +} + +int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr) +{ + int retcode = Jim_EvalExpression(interp, exprObjPtr); + + if (retcode == JIM_OK) { + switch (ExprBool(interp, Jim_GetResult(interp))) { + case 0: + *boolPtr = 0; + break; + + case 1: + *boolPtr = 1; + break; + + case -1: + retcode = JIM_ERR; + break; + } + } + return retcode; +} + + + + +typedef struct ScanFmtPartDescr +{ + const char *arg; + const char *prefix; + size_t width; + int pos; + char type; + char modifier; +} ScanFmtPartDescr; + + +typedef struct ScanFmtStringObj +{ + jim_wide size; + char *stringRep; + size_t count; + size_t convCount; + size_t maxPos; + const char *error; + char *scratch; + ScanFmtPartDescr descr[1]; +} ScanFmtStringObj; + + +static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static void UpdateStringOfScanFmt(Jim_Obj *objPtr); + +static const Jim_ObjType scanFmtStringObjType = { + "scanformatstring", + FreeScanFmtInternalRep, + DupScanFmtInternalRep, + UpdateStringOfScanFmt, + JIM_TYPE_NONE, +}; + +void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + JIM_NOTUSED(interp); + Jim_Free((char *)objPtr->internalRep.ptr); + objPtr->internalRep.ptr = 0; +} + +void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size; + ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size); + + JIM_NOTUSED(interp); + memcpy(newVec, srcPtr->internalRep.ptr, size); + dupPtr->internalRep.ptr = newVec; + dupPtr->typePtr = &scanFmtStringObjType; +} + +static void UpdateStringOfScanFmt(Jim_Obj *objPtr) +{ + JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep); +} + + +static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + ScanFmtStringObj *fmtObj; + char *buffer; + int maxCount, i, approxSize, lastPos = -1; + const char *fmt = Jim_String(objPtr); + int maxFmtLen = Jim_Length(objPtr); + const char *fmtEnd = fmt + maxFmtLen; + int curr; + + Jim_FreeIntRep(interp, objPtr); + + for (i = 0, maxCount = 0; i < maxFmtLen; ++i) + if (fmt[i] == '%') + ++maxCount; + + approxSize = sizeof(ScanFmtStringObj) + +(maxCount + 1) * sizeof(ScanFmtPartDescr) + +maxFmtLen * sizeof(char) + 3 + 1 + + maxFmtLen * sizeof(char) + 1 + + maxFmtLen * sizeof(char) + +(maxCount + 1) * sizeof(char) + +1; + fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize); + memset(fmtObj, 0, approxSize); + fmtObj->size = approxSize; + fmtObj->maxPos = 0; + fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1]; + fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1; + memcpy(fmtObj->stringRep, fmt, maxFmtLen); + buffer = fmtObj->stringRep + maxFmtLen + 1; + objPtr->internalRep.ptr = fmtObj; + objPtr->typePtr = &scanFmtStringObjType; + for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) { + int width = 0, skip; + ScanFmtPartDescr *descr = &fmtObj->descr[curr]; + + fmtObj->count++; + descr->width = 0; + + if (*fmt != '%' || fmt[1] == '%') { + descr->type = 0; + descr->prefix = &buffer[i]; + for (; fmt < fmtEnd; ++fmt) { + if (*fmt == '%') { + if (fmt[1] != '%') + break; + ++fmt; + } + buffer[i++] = *fmt; + } + buffer[i++] = 0; + } + + ++fmt; + + if (fmt >= fmtEnd) + goto done; + descr->pos = 0; + if (*fmt == '*') { + descr->pos = -1; + ++fmt; + } + else + fmtObj->convCount++; + + if (sscanf(fmt, "%d%n", &width, &skip) == 1) { + fmt += skip; + + if (descr->pos != -1 && *fmt == '$') { + int prev; + + ++fmt; + descr->pos = width; + width = 0; + + if ((lastPos == 0 && descr->pos > 0) + || (lastPos > 0 && descr->pos == 0)) { + fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers"; + return JIM_ERR; + } + + for (prev = 0; prev < curr; ++prev) { + if (fmtObj->descr[prev].pos == -1) + continue; + if (fmtObj->descr[prev].pos == descr->pos) { + fmtObj->error = + "variable is assigned by multiple \"%n$\" conversion specifiers"; + return JIM_ERR; + } + } + if (descr->pos < 0) { + fmtObj->error = + "\"%n$\" conversion specifier is negative"; + return JIM_ERR; + } + + if (sscanf(fmt, "%d%n", &width, &skip) == 1) { + descr->width = width; + fmt += skip; + } + if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos) + fmtObj->maxPos = descr->pos; + } + else { + + descr->width = width; + } + } + + if (lastPos == -1) + lastPos = descr->pos; + + if (*fmt == '[') { + int swapped = 1, beg = i, end, j; + + descr->type = '['; + descr->arg = &buffer[i]; + ++fmt; + if (*fmt == '^') + buffer[i++] = *fmt++; + if (*fmt == ']') + buffer[i++] = *fmt++; + while (*fmt && *fmt != ']') + buffer[i++] = *fmt++; + if (*fmt != ']') { + fmtObj->error = "unmatched [ in format string"; + return JIM_ERR; + } + end = i; + buffer[i++] = 0; + + while (swapped) { + swapped = 0; + for (j = beg + 1; j < end - 1; ++j) { + if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) { + char tmp = buffer[j - 1]; + + buffer[j - 1] = buffer[j + 1]; + buffer[j + 1] = tmp; + swapped = 1; + } + } + } + } + else { + + if (fmt < fmtEnd && strchr("hlL", *fmt)) + descr->modifier = tolower((int)*fmt++); + + if (fmt >= fmtEnd) { + fmtObj->error = "missing scan conversion character"; + return JIM_ERR; + } + + descr->type = *fmt; + if (strchr("efgcsndoxui", *fmt) == 0) { + fmtObj->error = "bad scan conversion character"; + return JIM_ERR; + } + else if (*fmt == 'c' && descr->width != 0) { + fmtObj->error = "field width may not be specified in %c " "conversion"; + return JIM_ERR; + } + else if (*fmt == 'u' && descr->modifier == 'l') { + fmtObj->error = "unsigned wide not supported"; + return JIM_ERR; + } + } + curr++; + } + done: + return JIM_OK; +} + + + +#define FormatGetCnvCount(_fo_) \ + ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount +#define FormatGetMaxPos(_fo_) \ + ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos +#define FormatGetError(_fo_) \ + ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error + +static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str) +{ + char *buffer = Jim_StrDup(str); + char *p = buffer; + + while (*str) { + int c; + int n; + + if (!sdescr && isspace(UCHAR(*str))) + break; + + n = utf8_tounicode(str, &c); + if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN)) + break; + while (n--) + *p++ = *str++; + } + *p = 0; + return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer); +} + + +static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen, + ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr) +{ + const char *tok; + const ScanFmtPartDescr *descr = &fmtObj->descr[idx]; + size_t scanned = 0; + size_t anchor = pos; + int i; + Jim_Obj *tmpObj = NULL; + + + *valObjPtr = 0; + if (descr->prefix) { + for (i = 0; pos < strLen && descr->prefix[i]; ++i) { + + if (isspace(UCHAR(descr->prefix[i]))) + while (pos < strLen && isspace(UCHAR(str[pos]))) + ++pos; + else if (descr->prefix[i] != str[pos]) + break; + else + ++pos; + } + if (pos >= strLen) { + return -1; + } + else if (descr->prefix[i] != 0) + return 0; + } + + if (descr->type != 'c' && descr->type != '[' && descr->type != 'n') + while (isspace(UCHAR(str[pos]))) + ++pos; + + scanned = pos - anchor; + + + if (descr->type == 'n') { + + *valObjPtr = Jim_NewIntObj(interp, anchor + scanned); + } + else if (pos >= strLen) { + + return -1; + } + else if (descr->type == 'c') { + int c; + scanned += utf8_tounicode(&str[pos], &c); + *valObjPtr = Jim_NewIntObj(interp, c); + return scanned; + } + else { + + if (descr->width > 0) { + size_t sLen = utf8_strlen(&str[pos], strLen - pos); + size_t tLen = descr->width > sLen ? sLen : descr->width; + + tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen); + tok = tmpObj->bytes; + } + else { + + tok = &str[pos]; + } + switch (descr->type) { + case 'd': + case 'o': + case 'x': + case 'u': + case 'i':{ + char *endp; + jim_wide w; + + int base = descr->type == 'o' ? 8 + : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10; + + + if (base == 0) { + w = jim_strtoull(tok, &endp); + } + else { + w = strtoull(tok, &endp, base); + } + + if (endp != tok) { + + *valObjPtr = Jim_NewIntObj(interp, w); + + + scanned += endp - tok; + } + else { + scanned = *tok ? 0 : -1; + } + break; + } + case 's': + case '[':{ + *valObjPtr = JimScanAString(interp, descr->arg, tok); + scanned += Jim_Length(*valObjPtr); + break; + } + case 'e': + case 'f': + case 'g':{ + char *endp; + double value = strtod(tok, &endp); + + if (endp != tok) { + + *valObjPtr = Jim_NewDoubleObj(interp, value); + + scanned += endp - tok; + } + else { + scanned = *tok ? 0 : -1; + } + break; + } + } + if (tmpObj) { + Jim_FreeNewObj(interp, tmpObj); + } + } + return scanned; +} + + +Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags) +{ + size_t i, pos; + int scanned = 1; + const char *str = Jim_String(strObjPtr); + int strLen = Jim_Utf8Length(interp, strObjPtr); + Jim_Obj *resultList = 0; + Jim_Obj **resultVec = 0; + int resultc; + Jim_Obj *emptyStr = 0; + ScanFmtStringObj *fmtObj; + + + JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format")); + + fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr; + + if (fmtObj->error != 0) { + if (flags & JIM_ERRMSG) + Jim_SetResultString(interp, fmtObj->error, -1); + return 0; + } + + emptyStr = Jim_NewEmptyStringObj(interp); + Jim_IncrRefCount(emptyStr); + + resultList = Jim_NewListObj(interp, NULL, 0); + if (fmtObj->maxPos > 0) { + for (i = 0; i < fmtObj->maxPos; ++i) + Jim_ListAppendElement(interp, resultList, emptyStr); + JimListGetElements(interp, resultList, &resultc, &resultVec); + } + + for (i = 0, pos = 0; i < fmtObj->count; ++i) { + ScanFmtPartDescr *descr = &(fmtObj->descr[i]); + Jim_Obj *value = 0; + + + if (descr->type == 0) + continue; + + if (scanned > 0) + scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value); + + if (scanned == -1 && i == 0) + goto eof; + + pos += scanned; + + + if (value == 0) + value = Jim_NewEmptyStringObj(interp); + + if (descr->pos == -1) { + Jim_FreeNewObj(interp, value); + } + else if (descr->pos == 0) + + Jim_ListAppendElement(interp, resultList, value); + else if (resultVec[descr->pos - 1] == emptyStr) { + + Jim_DecrRefCount(interp, resultVec[descr->pos - 1]); + Jim_IncrRefCount(value); + resultVec[descr->pos - 1] = value; + } + else { + + Jim_FreeNewObj(interp, value); + goto err; + } + } + Jim_DecrRefCount(interp, emptyStr); + return resultList; + eof: + Jim_DecrRefCount(interp, emptyStr); + Jim_FreeNewObj(interp, resultList); + return (Jim_Obj *)EOF; + err: + Jim_DecrRefCount(interp, emptyStr); + Jim_FreeNewObj(interp, resultList); + return 0; +} + + +static void JimPrngInit(Jim_Interp *interp) +{ +#define PRNG_SEED_SIZE 256 + int i; + unsigned int *seed; + time_t t = time(NULL); + + interp->prngState = Jim_Alloc(sizeof(Jim_PrngState)); + + seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed)); + for (i = 0; i < PRNG_SEED_SIZE; i++) { + seed[i] = (rand() ^ t ^ clock()); + } + JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed)); + Jim_Free(seed); +} + + +static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len) +{ + Jim_PrngState *prng; + unsigned char *destByte = (unsigned char *)dest; + unsigned int si, sj, x; + + + if (interp->prngState == NULL) + JimPrngInit(interp); + prng = interp->prngState; + + for (x = 0; x < len; x++) { + prng->i = (prng->i + 1) & 0xff; + si = prng->sbox[prng->i]; + prng->j = (prng->j + si) & 0xff; + sj = prng->sbox[prng->j]; + prng->sbox[prng->i] = sj; + prng->sbox[prng->j] = si; + *destByte++ = prng->sbox[(si + sj) & 0xff]; + } +} + + +static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen) +{ + int i; + Jim_PrngState *prng; + + + if (interp->prngState == NULL) + JimPrngInit(interp); + prng = interp->prngState; + + + for (i = 0; i < 256; i++) + prng->sbox[i] = i; + + for (i = 0; i < seedLen; i++) { + unsigned char t; + + t = prng->sbox[i & 0xFF]; + prng->sbox[i & 0xFF] = prng->sbox[seed[i]]; + prng->sbox[seed[i]] = t; + } + prng->i = prng->j = 0; + + for (i = 0; i < 256; i += seedLen) { + JimRandomBytes(interp, seed, seedLen); + } +} + + +static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + jim_wide wideValue, increment = 1; + Jim_Obj *intObjPtr; + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?"); + return JIM_ERR; + } + if (argc == 3) { + if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK) + return JIM_ERR; + } + intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED); + if (!intObjPtr) { + + wideValue = 0; + } + else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) { + return JIM_ERR; + } + if (!intObjPtr || Jim_IsShared(intObjPtr)) { + intObjPtr = Jim_NewIntObj(interp, wideValue + increment); + if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) { + Jim_FreeNewObj(interp, intObjPtr); + return JIM_ERR; + } + } + else { + + Jim_InvalidateStringRep(intObjPtr); + JimWideValue(intObjPtr) = wideValue + increment; + + if (argv[1]->typePtr != &variableObjType) { + + Jim_SetVariable(interp, argv[1], intObjPtr); + } + } + Jim_SetResult(interp, intObjPtr); + return JIM_OK; +} + + +#define JIM_EVAL_SARGV_LEN 8 +#define JIM_EVAL_SINTV_LEN 8 + + +static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retcode; + + if (interp->unknown_called > 50) { + return JIM_ERR; + } + + + + if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL) + return JIM_ERR; + + interp->unknown_called++; + + retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv); + interp->unknown_called--; + + return retcode; +} + +static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv) +{ + int retcode; + Jim_Cmd *cmdPtr; + void *prevPrivData; + +#if 0 + printf("invoke"); + int j; + for (j = 0; j < objc; j++) { + printf(" '%s'", Jim_String(objv[j])); + } + printf("\n"); +#endif + + if (interp->framePtr->tailcallCmd) { + + cmdPtr = interp->framePtr->tailcallCmd; + interp->framePtr->tailcallCmd = NULL; + } + else { + cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG); + if (cmdPtr == NULL) { + return JimUnknown(interp, objc, objv); + } + JimIncrCmdRefCount(cmdPtr); + } + + if (interp->evalDepth == interp->maxEvalDepth) { + Jim_SetResultString(interp, "Infinite eval recursion", -1); + retcode = JIM_ERR; + goto out; + } + interp->evalDepth++; + prevPrivData = interp->cmdPrivData; + + + Jim_SetEmptyResult(interp); + if (cmdPtr->isproc) { + retcode = JimCallProcedure(interp, cmdPtr, objc, objv); + } + else { + interp->cmdPrivData = cmdPtr->u.native.privData; + retcode = cmdPtr->u.native.cmdProc(interp, objc, objv); + } + interp->cmdPrivData = prevPrivData; + interp->evalDepth--; + +out: + JimDecrCmdRefCount(interp, cmdPtr); + + return retcode; +} + +int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv) +{ + int i, retcode; + + + for (i = 0; i < objc; i++) + Jim_IncrRefCount(objv[i]); + + retcode = JimInvokeCommand(interp, objc, objv); + + + for (i = 0; i < objc; i++) + Jim_DecrRefCount(interp, objv[i]); + + return retcode; +} + +int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv) +{ + int ret; + Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv)); + + nargv[0] = prefix; + memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc); + ret = Jim_EvalObjVector(interp, objc + 1, nargv); + Jim_Free(nargv); + return ret; +} + +static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script) +{ + if (!interp->errorFlag) { + + interp->errorFlag = 1; + Jim_IncrRefCount(script->fileNameObj); + Jim_DecrRefCount(interp, interp->errorFileNameObj); + interp->errorFileNameObj = script->fileNameObj; + interp->errorLine = script->linenr; + + JimResetStackTrace(interp); + + interp->addStackTrace++; + } + + + if (interp->addStackTrace > 0) { + + + JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr); + + if (Jim_Length(script->fileNameObj)) { + interp->addStackTrace = 0; + } + + Jim_DecrRefCount(interp, interp->errorProc); + interp->errorProc = interp->emptyObj; + Jim_IncrRefCount(interp->errorProc); + } +} + +static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr) +{ + Jim_Obj *objPtr; + + switch (token->type) { + case JIM_TT_STR: + case JIM_TT_ESC: + objPtr = token->objPtr; + break; + case JIM_TT_VAR: + objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG); + break; + case JIM_TT_DICTSUGAR: + objPtr = JimExpandDictSugar(interp, token->objPtr); + break; + case JIM_TT_EXPRSUGAR: + objPtr = JimExpandExprSugar(interp, token->objPtr); + break; + case JIM_TT_CMD: + switch (Jim_EvalObj(interp, token->objPtr)) { + case JIM_OK: + case JIM_RETURN: + objPtr = interp->result; + break; + case JIM_BREAK: + + return JIM_BREAK; + case JIM_CONTINUE: + + return JIM_CONTINUE; + default: + return JIM_ERR; + } + break; + default: + JimPanic((1, + "default token type (%d) reached " "in Jim_SubstObj().", token->type)); + objPtr = NULL; + break; + } + if (objPtr) { + *objPtrPtr = objPtr; + return JIM_OK; + } + return JIM_ERR; +} + +static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags) +{ + int totlen = 0, i; + Jim_Obj **intv; + Jim_Obj *sintv[JIM_EVAL_SINTV_LEN]; + Jim_Obj *objPtr; + char *s; + + if (tokens <= JIM_EVAL_SINTV_LEN) + intv = sintv; + else + intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens); + + for (i = 0; i < tokens; i++) { + switch (JimSubstOneToken(interp, &token[i], &intv[i])) { + case JIM_OK: + case JIM_RETURN: + break; + case JIM_BREAK: + if (flags & JIM_SUBST_FLAG) { + + tokens = i; + continue; + } + + + case JIM_CONTINUE: + if (flags & JIM_SUBST_FLAG) { + intv[i] = NULL; + continue; + } + + + default: + while (i--) { + Jim_DecrRefCount(interp, intv[i]); + } + if (intv != sintv) { + Jim_Free(intv); + } + return NULL; + } + Jim_IncrRefCount(intv[i]); + Jim_String(intv[i]); + totlen += intv[i]->length; + } + + + if (tokens == 1 && intv[0] && intv == sintv) { + + intv[0]->refCount--; + return intv[0]; + } + + objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0); + + if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC + && token[2].type == JIM_TT_VAR) { + + objPtr->typePtr = &interpolatedObjType; + objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr; + objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2]; + Jim_IncrRefCount(intv[2]); + } + else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) { + + JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber); + } + + + s = objPtr->bytes = Jim_Alloc(totlen + 1); + objPtr->length = totlen; + for (i = 0; i < tokens; i++) { + if (intv[i]) { + memcpy(s, intv[i]->bytes, intv[i]->length); + s += intv[i]->length; + Jim_DecrRefCount(interp, intv[i]); + } + } + objPtr->bytes[totlen] = '\0'; + + if (intv != sintv) { + Jim_Free(intv); + } + + return objPtr; +} + + +static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr) +{ + int retcode = JIM_OK; + + JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list.")); + + if (listPtr->internalRep.listValue.len) { + Jim_IncrRefCount(listPtr); + retcode = JimInvokeCommand(interp, + listPtr->internalRep.listValue.len, + listPtr->internalRep.listValue.ele); + Jim_DecrRefCount(interp, listPtr); + } + return retcode; +} + +int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr) +{ + SetListFromAny(interp, listPtr); + return JimEvalObjList(interp, listPtr); +} + +int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr) +{ + int i; + ScriptObj *script; + ScriptToken *token; + int retcode = JIM_OK; + Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL; + Jim_Obj *prevScriptObj; + + if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) { + return JimEvalObjList(interp, scriptObjPtr); + } + + Jim_IncrRefCount(scriptObjPtr); + script = JimGetScript(interp, scriptObjPtr); + if (!JimScriptValid(interp, script)) { + Jim_DecrRefCount(interp, scriptObjPtr); + return JIM_ERR; + } + + Jim_SetEmptyResult(interp); + + token = script->token; + +#ifdef JIM_OPTIMIZATION + if (script->len == 0) { + Jim_DecrRefCount(interp, scriptObjPtr); + return JIM_OK; + } + if (script->len == 3 + && token[1].objPtr->typePtr == &commandObjType + && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0 + && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand + && token[2].objPtr->typePtr == &variableObjType) { + + Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE); + + if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) { + JimWideValue(objPtr)++; + Jim_InvalidateStringRep(objPtr); + Jim_DecrRefCount(interp, scriptObjPtr); + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + } +#endif + + script->inUse++; + + + prevScriptObj = interp->currentScriptObj; + interp->currentScriptObj = scriptObjPtr; + + interp->errorFlag = 0; + argv = sargv; + + for (i = 0; i < script->len && retcode == JIM_OK; ) { + int argc; + int j; + + + argc = token[i].objPtr->internalRep.scriptLineValue.argc; + script->linenr = token[i].objPtr->internalRep.scriptLineValue.line; + + + if (argc > JIM_EVAL_SARGV_LEN) + argv = Jim_Alloc(sizeof(Jim_Obj *) * argc); + + + i++; + + for (j = 0; j < argc; j++) { + long wordtokens = 1; + int expand = 0; + Jim_Obj *wordObjPtr = NULL; + + if (token[i].type == JIM_TT_WORD) { + wordtokens = JimWideValue(token[i++].objPtr); + if (wordtokens < 0) { + expand = 1; + wordtokens = -wordtokens; + } + } + + if (wordtokens == 1) { + + switch (token[i].type) { + case JIM_TT_ESC: + case JIM_TT_STR: + wordObjPtr = token[i].objPtr; + break; + case JIM_TT_VAR: + wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG); + break; + case JIM_TT_EXPRSUGAR: + wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr); + break; + case JIM_TT_DICTSUGAR: + wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr); + break; + case JIM_TT_CMD: + retcode = Jim_EvalObj(interp, token[i].objPtr); + if (retcode == JIM_OK) { + wordObjPtr = Jim_GetResult(interp); + } + break; + default: + JimPanic((1, "default token type reached " "in Jim_EvalObj().")); + } + } + else { + wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE); + } + + if (!wordObjPtr) { + if (retcode == JIM_OK) { + retcode = JIM_ERR; + } + break; + } + + Jim_IncrRefCount(wordObjPtr); + i += wordtokens; + + if (!expand) { + argv[j] = wordObjPtr; + } + else { + + int len = Jim_ListLength(interp, wordObjPtr); + int newargc = argc + len - 1; + int k; + + if (len > 1) { + if (argv == sargv) { + if (newargc > JIM_EVAL_SARGV_LEN) { + argv = Jim_Alloc(sizeof(*argv) * newargc); + memcpy(argv, sargv, sizeof(*argv) * j); + } + } + else { + + argv = Jim_Realloc(argv, sizeof(*argv) * newargc); + } + } + + + for (k = 0; k < len; k++) { + argv[j++] = wordObjPtr->internalRep.listValue.ele[k]; + Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]); + } + + Jim_DecrRefCount(interp, wordObjPtr); + + + j--; + argc += len - 1; + } + } + + if (retcode == JIM_OK && argc) { + + retcode = JimInvokeCommand(interp, argc, argv); + + if (Jim_CheckSignal(interp)) { + retcode = JIM_SIGNAL; + } + } + + + while (j-- > 0) { + Jim_DecrRefCount(interp, argv[j]); + } + + if (argv != sargv) { + Jim_Free(argv); + argv = sargv; + } + } + + + if (retcode == JIM_ERR) { + JimAddErrorToStack(interp, script); + } + + else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) { + + interp->addStackTrace = 0; + } + + + interp->currentScriptObj = prevScriptObj; + + Jim_FreeIntRep(interp, scriptObjPtr); + scriptObjPtr->typePtr = &scriptObjType; + Jim_SetIntRepPtr(scriptObjPtr, script); + Jim_DecrRefCount(interp, scriptObjPtr); + + return retcode; +} + +static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj) +{ + int retcode; + + const char *varname = Jim_String(argNameObj); + if (*varname == '&') { + + Jim_Obj *objPtr; + Jim_CallFrame *savedCallFrame = interp->framePtr; + + interp->framePtr = interp->framePtr->parent; + objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG); + interp->framePtr = savedCallFrame; + if (!objPtr) { + return JIM_ERR; + } + + + objPtr = Jim_NewStringObj(interp, varname + 1, -1); + Jim_IncrRefCount(objPtr); + retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent); + Jim_DecrRefCount(interp, objPtr); + } + else { + retcode = Jim_SetVariable(interp, argNameObj, argValObj); + } + return retcode; +} + +static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd) +{ + + Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0); + int i; + + for (i = 0; i < cmd->u.proc.argListLen; i++) { + Jim_AppendString(interp, argmsg, " ", 1); + + if (i == cmd->u.proc.argsPos) { + if (cmd->u.proc.arglist[i].defaultObjPtr) { + + Jim_AppendString(interp, argmsg, "?", 1); + Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr); + Jim_AppendString(interp, argmsg, " ...?", -1); + } + else { + + Jim_AppendString(interp, argmsg, "?arg...?", -1); + } + } + else { + if (cmd->u.proc.arglist[i].defaultObjPtr) { + Jim_AppendString(interp, argmsg, "?", 1); + Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr); + Jim_AppendString(interp, argmsg, "?", 1); + } + else { + const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr); + if (*arg == '&') { + arg++; + } + Jim_AppendString(interp, argmsg, arg, -1); + } + } + } + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg); +} + +#ifdef jim_ext_namespace +int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj) +{ + Jim_CallFrame *callFramePtr; + int retcode; + + + callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj); + callFramePtr->argv = &interp->emptyObj; + callFramePtr->argc = 0; + callFramePtr->procArgsObjPtr = NULL; + callFramePtr->procBodyObjPtr = scriptObj; + callFramePtr->staticVars = NULL; + callFramePtr->fileNameObj = interp->emptyObj; + callFramePtr->line = 0; + Jim_IncrRefCount(scriptObj); + interp->framePtr = callFramePtr; + + + if (interp->framePtr->level == interp->maxCallFrameDepth) { + Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1); + retcode = JIM_ERR; + } + else { + + retcode = Jim_EvalObj(interp, scriptObj); + } + + + interp->framePtr = interp->framePtr->parent; + JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE); + + return retcode; +} +#endif + +static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv) +{ + Jim_CallFrame *callFramePtr; + int i, d, retcode, optargs; + ScriptObj *script; + + + if (argc - 1 < cmd->u.proc.reqArity || + (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) { + JimSetProcWrongArgs(interp, argv[0], cmd); + return JIM_ERR; + } + + if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) { + + return JIM_OK; + } + + + if (interp->framePtr->level == interp->maxCallFrameDepth) { + Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1); + return JIM_ERR; + } + + + callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj); + callFramePtr->argv = argv; + callFramePtr->argc = argc; + callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr; + callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr; + callFramePtr->staticVars = cmd->u.proc.staticVars; + + + script = JimGetScript(interp, interp->currentScriptObj); + callFramePtr->fileNameObj = script->fileNameObj; + callFramePtr->line = script->linenr; + + Jim_IncrRefCount(cmd->u.proc.argListObjPtr); + Jim_IncrRefCount(cmd->u.proc.bodyObjPtr); + interp->framePtr = callFramePtr; + + + optargs = (argc - 1 - cmd->u.proc.reqArity); + + + i = 1; + for (d = 0; d < cmd->u.proc.argListLen; d++) { + Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr; + if (d == cmd->u.proc.argsPos) { + + Jim_Obj *listObjPtr; + int argsLen = 0; + if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) { + argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity); + } + listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen); + + + if (cmd->u.proc.arglist[d].defaultObjPtr) { + nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr; + } + retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr); + if (retcode != JIM_OK) { + goto badargset; + } + + i += argsLen; + continue; + } + + + if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) { + retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]); + } + else { + + retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr); + } + if (retcode != JIM_OK) { + goto badargset; + } + } + + + retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr); + +badargset: + + + retcode = JimInvokeDefer(interp, retcode); + interp->framePtr = interp->framePtr->parent; + JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE); + + + if (interp->framePtr->tailcallObj) { + do { + Jim_Obj *tailcallObj = interp->framePtr->tailcallObj; + + interp->framePtr->tailcallObj = NULL; + + if (retcode == JIM_EVAL) { + retcode = Jim_EvalObjList(interp, tailcallObj); + if (retcode == JIM_RETURN) { + interp->returnLevel++; + } + } + Jim_DecrRefCount(interp, tailcallObj); + } while (interp->framePtr->tailcallObj); + + + if (interp->framePtr->tailcallCmd) { + JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd); + interp->framePtr->tailcallCmd = NULL; + } + } + + + if (retcode == JIM_RETURN) { + if (--interp->returnLevel <= 0) { + retcode = interp->returnCode; + interp->returnCode = JIM_OK; + interp->returnLevel = 0; + } + } + else if (retcode == JIM_ERR) { + interp->addStackTrace++; + Jim_DecrRefCount(interp, interp->errorProc); + interp->errorProc = argv[0]; + Jim_IncrRefCount(interp->errorProc); + } + + return retcode; +} + +int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script) +{ + int retval; + Jim_Obj *scriptObjPtr; + + scriptObjPtr = Jim_NewStringObj(interp, script, -1); + Jim_IncrRefCount(scriptObjPtr); + + if (filename) { + Jim_Obj *prevScriptObj; + + JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno); + + 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; +} + +int Jim_Eval(Jim_Interp *interp, const char *script) +{ + return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1)); +} + + +int Jim_EvalGlobal(Jim_Interp *interp, const char *script) +{ + int retval; + Jim_CallFrame *savedFramePtr = interp->framePtr; + + interp->framePtr = interp->topFramePtr; + retval = Jim_Eval(interp, script); + interp->framePtr = savedFramePtr; + + return retval; +} + +int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename) +{ + int retval; + Jim_CallFrame *savedFramePtr = interp->framePtr; + + interp->framePtr = interp->topFramePtr; + retval = Jim_EvalFile(interp, filename); + interp->framePtr = savedFramePtr; + + return retval; +} + +#include + +int Jim_EvalFile(Jim_Interp *interp, const char *filename) +{ + FILE *fp; + char *buf; + Jim_Obj *scriptObjPtr; + Jim_Obj *prevScriptObj; + struct stat sb; + int retcode; + int readlen; + + if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) { + Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + if (sb.st_size == 0) { + fclose(fp); + return JIM_OK; + } + + buf = Jim_Alloc(sb.st_size + 1); + readlen = fread(buf, 1, sb.st_size, fp); + if (ferror(fp)) { + fclose(fp); + Jim_Free(buf); + Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + fclose(fp); + buf[readlen] = 0; + + scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen); + JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1); + Jim_IncrRefCount(scriptObjPtr); + + prevScriptObj = interp->currentScriptObj; + interp->currentScriptObj = scriptObjPtr; + + retcode = Jim_EvalObj(interp, scriptObjPtr); + + + if (retcode == JIM_RETURN) { + if (--interp->returnLevel <= 0) { + retcode = interp->returnCode; + interp->returnCode = JIM_OK; + interp->returnLevel = 0; + } + } + if (retcode == JIM_ERR) { + + interp->addStackTrace++; + } + + interp->currentScriptObj = prevScriptObj; + + Jim_DecrRefCount(interp, scriptObjPtr); + + return retcode; +} + +static void JimParseSubst(struct JimParserCtx *pc, int flags) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + + if (pc->len == 0) { + pc->tend = pc->p; + pc->tt = JIM_TT_EOL; + pc->eof = 1; + return; + } + if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) { + JimParseCmd(pc); + return; + } + if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) { + if (JimParseVar(pc) == JIM_OK) { + return; + } + + pc->tstart = pc->p; + flags |= JIM_SUBST_NOVAR; + } + while (pc->len) { + if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) { + break; + } + if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) { + break; + } + if (*pc->p == '\\' && pc->len > 1) { + pc->p++; + pc->len--; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC; +} + + +static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags) +{ + int scriptTextLen; + const char *scriptText = Jim_GetString(objPtr, &scriptTextLen); + struct JimParserCtx parser; + struct ScriptObj *script = Jim_Alloc(sizeof(*script)); + ParseTokenList tokenlist; + + + ScriptTokenListInit(&tokenlist); + + JimParserInit(&parser, scriptText, scriptTextLen, 1); + while (1) { + JimParseSubst(&parser, flags); + if (parser.eof) { + + break; + } + ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt, + parser.tline); + } + + + script->inUse = 1; + script->substFlags = flags; + script->fileNameObj = interp->emptyObj; + Jim_IncrRefCount(script->fileNameObj); + SubstObjAddTokens(interp, script, &tokenlist); + + + ScriptTokenListFree(&tokenlist); + +#ifdef DEBUG_SHOW_SUBST + { + int i; + + printf("==== Subst ====\n"); + for (i = 0; i < script->len; i++) { + printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type), + Jim_String(script->token[i].objPtr)); + } + } +#endif + + + Jim_FreeIntRep(interp, objPtr); + Jim_SetIntRepPtr(objPtr, script); + objPtr->typePtr = &scriptObjType; + return JIM_OK; +} + +static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags) + SetSubstFromAny(interp, objPtr, flags); + return (ScriptObj *) Jim_GetIntRepPtr(objPtr); +} + +int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags) +{ + ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags); + + Jim_IncrRefCount(substObjPtr); + script->inUse++; + + *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags); + + script->inUse--; + Jim_DecrRefCount(interp, substObjPtr); + if (*resObjPtrPtr == NULL) { + return JIM_ERR; + } + return JIM_OK; +} + +void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg) +{ + Jim_Obj *objPtr; + Jim_Obj *listObjPtr; + + JimPanic((argc == 0, "Jim_WrongNumArgs() called with argc=0")); + + listObjPtr = Jim_NewListObj(interp, argv, argc); + + if (msg && *msg) { + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1)); + } + Jim_IncrRefCount(listObjPtr); + objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1); + Jim_DecrRefCount(interp, listObjPtr); + + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr); +} + +typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, + Jim_HashEntry *he, int type); + +#define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL) + +static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr, + JimHashtableIteratorCallbackType *callback, int type) +{ + Jim_HashEntry *he; + Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0); + + + if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) { + he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr)); + if (he) { + callback(interp, listObjPtr, he, type); + } + } + else { + Jim_HashTableIterator htiter; + JimInitHashTableIterator(ht, &htiter); + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) { + callback(interp, listObjPtr, he, type); + } + } + } + return listObjPtr; +} + + +#define JIM_CMDLIST_COMMANDS 0 +#define JIM_CMDLIST_PROCS 1 +#define JIM_CMDLIST_CHANNELS 2 + +static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, + Jim_HashEntry *he, int type) +{ + Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he); + Jim_Obj *objPtr; + + if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) { + + return; + } + + objPtr = Jim_NewStringObj(interp, he->key, -1); + Jim_IncrRefCount(objPtr); + + if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) { + Jim_ListAppendElement(interp, listObjPtr, objPtr); + } + Jim_DecrRefCount(interp, objPtr); +} + + +static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type) +{ + return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type); +} + + +#define JIM_VARLIST_GLOBALS 0 +#define JIM_VARLIST_LOCALS 1 +#define JIM_VARLIST_VARS 2 + +#define JIM_VARLIST_VALUES 0x1000 + +static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, + Jim_HashEntry *he, int type) +{ + Jim_Var *varPtr = Jim_GetHashEntryVal(he); + + if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) { + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1)); + if (type & JIM_VARLIST_VALUES) { + Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr); + } + } +} + + +static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode) +{ + if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) { + return interp->emptyObj; + } + else { + Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr; + return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode); + } +} + +static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr, + Jim_Obj **objPtrPtr, int info_level_cmd) +{ + Jim_CallFrame *targetCallFrame; + + targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr); + if (targetCallFrame == NULL) { + return JIM_ERR; + } + + if (targetCallFrame == interp->topFramePtr) { + Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr); + return JIM_ERR; + } + if (info_level_cmd) { + *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc); + } + else { + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + + Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]); + Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj); + Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line)); + *objPtrPtr = listObj; + } + return JIM_OK; +} + + + +static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string"); + return JIM_ERR; + } + if (argc == 3) { + if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) { + Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1); + return JIM_ERR; + } + else { + fputs(Jim_String(argv[2]), stdout); + } + } + else { + puts(Jim_String(argv[1])); + } + return JIM_OK; +} + + +static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op) +{ + jim_wide wideValue, res; + double doubleValue, doubleRes; + int i; + + res = (op == JIM_EXPROP_ADD) ? 0 : 1; + + for (i = 1; i < argc; i++) { + if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) + goto trydouble; + if (op == JIM_EXPROP_ADD) + res += wideValue; + else + res *= wideValue; + } + Jim_SetResultInt(interp, res); + return JIM_OK; + trydouble: + doubleRes = (double)res; + for (; i < argc; i++) { + if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK) + return JIM_ERR; + if (op == JIM_EXPROP_ADD) + doubleRes += doubleValue; + else + doubleRes *= doubleValue; + } + Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes)); + return JIM_OK; +} + + +static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op) +{ + jim_wide wideValue, res = 0; + double doubleValue, doubleRes = 0; + int i = 2; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?"); + return JIM_ERR; + } + else if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) { + if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) { + return JIM_ERR; + } + else { + if (op == JIM_EXPROP_SUB) + doubleRes = -doubleValue; + else + doubleRes = 1.0 / doubleValue; + Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes)); + return JIM_OK; + } + } + if (op == JIM_EXPROP_SUB) { + res = -wideValue; + Jim_SetResultInt(interp, res); + } + else { + doubleRes = 1.0 / wideValue; + Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes)); + } + return JIM_OK; + } + else { + if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) { + if (Jim_GetDouble(interp, argv[1], &doubleRes) + != JIM_OK) { + return JIM_ERR; + } + else { + goto trydouble; + } + } + } + for (i = 2; i < argc; i++) { + if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) { + doubleRes = (double)res; + goto trydouble; + } + if (op == JIM_EXPROP_SUB) + res -= wideValue; + else { + if (wideValue == 0) { + Jim_SetResultString(interp, "Division by zero", -1); + return JIM_ERR; + } + res /= wideValue; + } + } + Jim_SetResultInt(interp, res); + return JIM_OK; + trydouble: + for (; i < argc; i++) { + if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK) + return JIM_ERR; + if (op == JIM_EXPROP_SUB) + doubleRes -= doubleValue; + else + doubleRes /= doubleValue; + } + Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes)); + return JIM_OK; +} + + + +static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD); +} + + +static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL); +} + + +static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB); +} + + +static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV); +} + + +static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?"); + return JIM_ERR; + } + if (argc == 2) { + Jim_Obj *objPtr; + + objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG); + if (!objPtr) + return JIM_ERR; + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK) + return JIM_ERR; + Jim_SetResult(interp, argv[2]); + return JIM_OK; +} + +static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i = 1; + int complain = 1; + + while (i < argc) { + if (Jim_CompareStringImmediate(interp, argv[i], "--")) { + i++; + break; + } + if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) { + complain = 0; + i++; + continue; + } + break; + } + + while (i < argc) { + if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK + && complain) { + return JIM_ERR; + } + i++; + } + return JIM_OK; +} + + +static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "condition body"); + return JIM_ERR; + } + + + while (1) { + int boolean, retval; + + if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK) + return retval; + if (!boolean) + break; + + if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) { + switch (retval) { + case JIM_BREAK: + goto out; + break; + case JIM_CONTINUE: + continue; + break; + default: + return retval; + } + } + } + out: + Jim_SetEmptyResult(interp); + return JIM_OK; +} + + +static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retval; + int boolean = 1; + Jim_Obj *varNamePtr = NULL; + Jim_Obj *stopVarNamePtr = NULL; + + if (argc != 5) { + Jim_WrongNumArgs(interp, 1, argv, "start test next body"); + return JIM_ERR; + } + + + if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) { + return retval; + } + + retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean); + + +#ifdef JIM_OPTIMIZATION + if (retval == JIM_OK && boolean) { + ScriptObj *incrScript; + struct ExprTree *expr; + jim_wide stop, currentVal; + Jim_Obj *objPtr; + int cmpOffset; + + + expr = JimGetExpression(interp, argv[2]); + incrScript = JimGetScript(interp, argv[3]); + + + if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) { + goto evalstart; + } + + if (incrScript->token[1].type != JIM_TT_ESC) { + goto evalstart; + } + + if (expr->expr->type == JIM_EXPROP_LT) { + cmpOffset = 0; + } + else if (expr->expr->type == JIM_EXPROP_LTE) { + cmpOffset = 1; + } + else { + goto evalstart; + } + + if (expr->expr->left->type != JIM_TT_VAR) { + goto evalstart; + } + + if (expr->expr->right->type != JIM_TT_VAR && expr->expr->right->type != JIM_TT_EXPR_INT) { + goto evalstart; + } + + + if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) { + goto evalstart; + } + + + if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->expr->left->objPtr)) { + goto evalstart; + } + + + if (expr->expr->right->type == JIM_TT_EXPR_INT) { + if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) { + goto evalstart; + } + } + else { + stopVarNamePtr = expr->expr->right->objPtr; + Jim_IncrRefCount(stopVarNamePtr); + + stop = 0; + } + + + varNamePtr = expr->expr->left->objPtr; + Jim_IncrRefCount(varNamePtr); + + objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE); + if (objPtr == NULL || Jim_GetWide(interp, objPtr, ¤tVal) != JIM_OK) { + goto testcond; + } + + + while (retval == JIM_OK) { + + + + + if (stopVarNamePtr) { + objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE); + if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) { + goto testcond; + } + } + + if (currentVal >= stop + cmpOffset) { + break; + } + + + retval = Jim_EvalObj(interp, argv[4]); + if (retval == JIM_OK || retval == JIM_CONTINUE) { + retval = JIM_OK; + + objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG); + + + if (objPtr == NULL) { + retval = JIM_ERR; + goto out; + } + if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) { + currentVal = ++JimWideValue(objPtr); + Jim_InvalidateStringRep(objPtr); + } + else { + if (Jim_GetWide(interp, objPtr, ¤tVal) != JIM_OK || + Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp, + ++currentVal)) != JIM_OK) { + goto evalnext; + } + } + } + } + goto out; + } + evalstart: +#endif + + while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) { + + retval = Jim_EvalObj(interp, argv[4]); + + if (retval == JIM_OK || retval == JIM_CONTINUE) { + +JIM_IF_OPTIM(evalnext:) + retval = Jim_EvalObj(interp, argv[3]); + if (retval == JIM_OK || retval == JIM_CONTINUE) { + +JIM_IF_OPTIM(testcond:) + retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean); + } + } + } +JIM_IF_OPTIM(out:) + if (stopVarNamePtr) { + Jim_DecrRefCount(interp, stopVarNamePtr); + } + if (varNamePtr) { + Jim_DecrRefCount(interp, varNamePtr); + } + + if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) { + Jim_SetEmptyResult(interp); + return JIM_OK; + } + + return retval; +} + + +static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retval; + jim_wide i; + jim_wide limit; + jim_wide incr = 1; + Jim_Obj *bodyObjPtr; + + if (argc != 5 && argc != 6) { + Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body"); + return JIM_ERR; + } + + if (Jim_GetWide(interp, argv[2], &i) != JIM_OK || + Jim_GetWide(interp, argv[3], &limit) != JIM_OK || + (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) { + return JIM_ERR; + } + bodyObjPtr = (argc == 5) ? argv[4] : argv[5]; + + retval = Jim_SetVariable(interp, argv[1], argv[2]); + + while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) { + retval = Jim_EvalObj(interp, bodyObjPtr); + if (retval == JIM_OK || retval == JIM_CONTINUE) { + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG); + + retval = JIM_OK; + + + i += incr; + + if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) { + if (argv[1]->typePtr != &variableObjType) { + if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) { + return JIM_ERR; + } + } + JimWideValue(objPtr) = i; + Jim_InvalidateStringRep(objPtr); + + if (argv[1]->typePtr != &variableObjType) { + if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) { + retval = JIM_ERR; + break; + } + } + } + else { + objPtr = Jim_NewIntObj(interp, i); + retval = Jim_SetVariable(interp, argv[1], objPtr); + if (retval != JIM_OK) { + Jim_FreeNewObj(interp, objPtr); + } + } + } + } + + if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) { + Jim_SetEmptyResult(interp); + return JIM_OK; + } + return retval; +} + +typedef struct { + Jim_Obj *objPtr; + int idx; +} Jim_ListIter; + +static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr) +{ + iter->objPtr = objPtr; + iter->idx = 0; +} + +static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter) +{ + if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) { + return NULL; + } + return iter->objPtr->internalRep.listValue.ele[iter->idx++]; +} + +static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter) +{ + return iter->idx >= Jim_ListLength(interp, iter->objPtr); +} + + +static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap) +{ + int result = JIM_OK; + int i, numargs; + Jim_ListIter twoiters[2]; + Jim_ListIter *iters; + Jim_Obj *script; + Jim_Obj *resultObj; + + if (argc < 4 || argc % 2 != 0) { + Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script"); + return JIM_ERR; + } + script = argv[argc - 1]; + numargs = (argc - 1 - 1); + + if (numargs == 2) { + iters = twoiters; + } + else { + iters = Jim_Alloc(numargs * sizeof(*iters)); + } + for (i = 0; i < numargs; i++) { + JimListIterInit(&iters[i], argv[i + 1]); + if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) { + result = JIM_ERR; + } + } + if (result != JIM_OK) { + Jim_SetResultString(interp, "foreach varlist is empty", -1); + goto empty_varlist; + } + + if (doMap) { + resultObj = Jim_NewListObj(interp, NULL, 0); + } + else { + resultObj = interp->emptyObj; + } + Jim_IncrRefCount(resultObj); + + while (1) { + + for (i = 0; i < numargs; i += 2) { + if (!JimListIterDone(interp, &iters[i + 1])) { + break; + } + } + if (i == numargs) { + + break; + } + + + for (i = 0; i < numargs; i += 2) { + Jim_Obj *varName; + + + JimListIterInit(&iters[i], argv[i + 1]); + while ((varName = JimListIterNext(interp, &iters[i])) != NULL) { + Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]); + if (!valObj) { + + valObj = interp->emptyObj; + } + + Jim_IncrRefCount(valObj); + result = Jim_SetVariable(interp, varName, valObj); + Jim_DecrRefCount(interp, valObj); + if (result != JIM_OK) { + goto err; + } + } + } + switch (result = Jim_EvalObj(interp, script)) { + case JIM_OK: + if (doMap) { + Jim_ListAppendElement(interp, resultObj, interp->result); + } + break; + case JIM_CONTINUE: + break; + case JIM_BREAK: + goto out; + default: + goto err; + } + } + out: + result = JIM_OK; + Jim_SetResult(interp, resultObj); + err: + Jim_DecrRefCount(interp, resultObj); + empty_varlist: + if (numargs > 2) { + Jim_Free(iters); + } + return result; +} + + +static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimForeachMapHelper(interp, argc, argv, 0); +} + + +static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimForeachMapHelper(interp, argc, argv, 1); +} + + +static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int result = JIM_ERR; + int i; + Jim_ListIter iter; + Jim_Obj *resultObj; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?"); + return JIM_ERR; + } + + JimListIterInit(&iter, argv[1]); + + for (i = 2; i < argc; i++) { + Jim_Obj *valObj = JimListIterNext(interp, &iter); + result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj); + if (result != JIM_OK) { + return result; + } + } + + resultObj = Jim_NewListObj(interp, NULL, 0); + while (!JimListIterDone(interp, &iter)) { + Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter)); + } + + Jim_SetResult(interp, resultObj); + + return JIM_OK; +} + + +static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int boolean, retval, current = 1, falsebody = 0; + + if (argc >= 3) { + while (1) { + + if (current >= argc) + goto err; + if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean)) + != JIM_OK) + return retval; + + if (current >= argc) + goto err; + if (Jim_CompareStringImmediate(interp, argv[current], "then")) + current++; + + if (current >= argc) + goto err; + if (boolean) + return Jim_EvalObj(interp, argv[current]); + + if (++current >= argc) { + Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); + return JIM_OK; + } + falsebody = current++; + if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) { + + if (current != argc - 1) + goto err; + return Jim_EvalObj(interp, argv[current]); + } + else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif")) + continue; + + else if (falsebody != argc - 1) + goto err; + return Jim_EvalObj(interp, argv[falsebody]); + } + return JIM_OK; + } + err: + Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody"); + return JIM_ERR; +} + + + +int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj, + Jim_Obj *stringObj, int nocase) +{ + Jim_Obj *parms[4]; + int argc = 0; + long eq; + int rc; + + parms[argc++] = commandObj; + if (nocase) { + parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1); + } + parms[argc++] = patternObj; + parms[argc++] = stringObj; + + rc = Jim_EvalObjVector(interp, argc, parms); + + if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) { + eq = -rc; + } + + return eq; +} + + +static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD }; + int matchOpt = SWITCH_EXACT, opt = 1, patCount, i; + Jim_Obj *command = NULL, *scriptObj = NULL, *strObj; + Jim_Obj **caseList; + + if (argc < 3) { + wrongnumargs: + Jim_WrongNumArgs(interp, 1, argv, "?options? string " + "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}"); + return JIM_ERR; + } + for (opt = 1; opt < argc; ++opt) { + const char *option = Jim_String(argv[opt]); + + if (*option != '-') + break; + else if (strncmp(option, "--", 2) == 0) { + ++opt; + break; + } + else if (strncmp(option, "-exact", 2) == 0) + matchOpt = SWITCH_EXACT; + else if (strncmp(option, "-glob", 2) == 0) + matchOpt = SWITCH_GLOB; + else if (strncmp(option, "-regexp", 2) == 0) + matchOpt = SWITCH_RE; + else if (strncmp(option, "-command", 2) == 0) { + matchOpt = SWITCH_CMD; + if ((argc - opt) < 2) + goto wrongnumargs; + command = argv[++opt]; + } + else { + Jim_SetResultFormatted(interp, + "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --", + argv[opt]); + return JIM_ERR; + } + if ((argc - opt) < 2) + goto wrongnumargs; + } + strObj = argv[opt++]; + patCount = argc - opt; + if (patCount == 1) { + JimListGetElements(interp, argv[opt], &patCount, &caseList); + } + else + caseList = (Jim_Obj **)&argv[opt]; + if (patCount == 0 || patCount % 2 != 0) + goto wrongnumargs; + for (i = 0; scriptObj == NULL && i < patCount; i += 2) { + Jim_Obj *patObj = caseList[i]; + + if (!Jim_CompareStringImmediate(interp, patObj, "default") + || i < (patCount - 2)) { + switch (matchOpt) { + case SWITCH_EXACT: + if (Jim_StringEqObj(strObj, patObj)) + scriptObj = caseList[i + 1]; + break; + case SWITCH_GLOB: + if (Jim_StringMatchObj(interp, patObj, strObj, 0)) + scriptObj = caseList[i + 1]; + break; + case SWITCH_RE: + command = Jim_NewStringObj(interp, "regexp", -1); + + case SWITCH_CMD:{ + int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0); + + if (argc - opt == 1) { + JimListGetElements(interp, argv[opt], &patCount, &caseList); + } + + if (rc < 0) { + return -rc; + } + if (rc) + scriptObj = caseList[i + 1]; + break; + } + } + } + else { + scriptObj = caseList[i + 1]; + } + } + for (; i < patCount && Jim_CompareStringImmediate(interp, scriptObj, "-"); i += 2) + scriptObj = caseList[i + 1]; + if (scriptObj && Jim_CompareStringImmediate(interp, scriptObj, "-")) { + Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]); + return JIM_ERR; + } + Jim_SetEmptyResult(interp); + if (scriptObj) { + return Jim_EvalObj(interp, scriptObj); + } + return JIM_OK; +} + + +static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *listObjPtr; + + listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1); + Jim_SetResult(interp, listObjPtr); + return JIM_OK; +} + + +static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr, *listObjPtr; + int i; + int idx; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?"); + return JIM_ERR; + } + objPtr = argv[1]; + Jim_IncrRefCount(objPtr); + for (i = 2; i < argc; i++) { + listObjPtr = objPtr; + if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) { + Jim_DecrRefCount(interp, listObjPtr); + return JIM_ERR; + } + if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) { + Jim_DecrRefCount(interp, listObjPtr); + Jim_SetEmptyResult(interp); + return JIM_OK; + } + Jim_IncrRefCount(objPtr); + Jim_DecrRefCount(interp, listObjPtr); + } + Jim_SetResult(interp, objPtr); + Jim_DecrRefCount(interp, objPtr); + return JIM_OK; +} + + +static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "list"); + return JIM_ERR; + } + Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1])); + return JIM_OK; +} + + +static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + static const char * const options[] = { + "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command", + NULL + }; + enum + { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE, + OPT_COMMAND }; + int i; + int opt_bool = 0; + int opt_not = 0; + int opt_nocase = 0; + int opt_all = 0; + int opt_inline = 0; + int opt_match = OPT_EXACT; + int listlen; + int rc = JIM_OK; + Jim_Obj *listObjPtr = NULL; + Jim_Obj *commandObj = NULL; + + if (argc < 3) { + wrongargs: + Jim_WrongNumArgs(interp, 1, argv, + "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value"); + return JIM_ERR; + } + + for (i = 1; i < argc - 2; i++) { + int option; + + if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_BOOL: + opt_bool = 1; + opt_inline = 0; + break; + case OPT_NOT: + opt_not = 1; + break; + case OPT_NOCASE: + opt_nocase = 1; + break; + case OPT_INLINE: + opt_inline = 1; + opt_bool = 0; + break; + case OPT_ALL: + opt_all = 1; + break; + case OPT_COMMAND: + if (i >= argc - 2) { + goto wrongargs; + } + commandObj = argv[++i]; + + case OPT_EXACT: + case OPT_GLOB: + case OPT_REGEXP: + opt_match = option; + break; + } + } + + argv += i; + + if (opt_all) { + listObjPtr = Jim_NewListObj(interp, NULL, 0); + } + if (opt_match == OPT_REGEXP) { + commandObj = Jim_NewStringObj(interp, "regexp", -1); + } + if (commandObj) { + Jim_IncrRefCount(commandObj); + } + + listlen = Jim_ListLength(interp, argv[0]); + for (i = 0; i < listlen; i++) { + int eq = 0; + Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i); + + switch (opt_match) { + case OPT_EXACT: + eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0; + break; + + case OPT_GLOB: + eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase); + break; + + case OPT_REGEXP: + case OPT_COMMAND: + eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase); + if (eq < 0) { + if (listObjPtr) { + Jim_FreeNewObj(interp, listObjPtr); + } + rc = JIM_ERR; + goto done; + } + break; + } + + + if (!eq && opt_bool && opt_not && !opt_all) { + continue; + } + + if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) { + + Jim_Obj *resultObj; + + if (opt_bool) { + resultObj = Jim_NewIntObj(interp, eq ^ opt_not); + } + else if (!opt_inline) { + resultObj = Jim_NewIntObj(interp, i); + } + else { + resultObj = objPtr; + } + + if (opt_all) { + Jim_ListAppendElement(interp, listObjPtr, resultObj); + } + else { + Jim_SetResult(interp, resultObj); + goto done; + } + } + } + + if (opt_all) { + Jim_SetResult(interp, listObjPtr); + } + else { + + if (opt_bool) { + Jim_SetResultBool(interp, opt_not); + } + else if (!opt_inline) { + Jim_SetResultInt(interp, -1); + } + } + + done: + if (commandObj) { + Jim_DecrRefCount(interp, commandObj); + } + return rc; +} + + +static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *listObjPtr; + int new_obj = 0; + int i; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?"); + return JIM_ERR; + } + listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED); + if (!listObjPtr) { + + listObjPtr = Jim_NewListObj(interp, NULL, 0); + new_obj = 1; + } + else if (Jim_IsShared(listObjPtr)) { + listObjPtr = Jim_DuplicateObj(interp, listObjPtr); + new_obj = 1; + } + for (i = 2; i < argc; i++) + Jim_ListAppendElement(interp, listObjPtr, argv[i]); + if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) { + if (new_obj) + Jim_FreeNewObj(interp, listObjPtr); + return JIM_ERR; + } + Jim_SetResult(interp, listObjPtr); + return JIM_OK; +} + + +static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int idx, len; + Jim_Obj *listPtr; + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?"); + return JIM_ERR; + } + listPtr = argv[1]; + if (Jim_IsShared(listPtr)) + listPtr = Jim_DuplicateObj(interp, listPtr); + if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK) + goto err; + len = Jim_ListLength(interp, listPtr); + if (idx >= len) + idx = len; + else if (idx < 0) + idx = len + idx + 1; + Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]); + Jim_SetResult(interp, listPtr); + return JIM_OK; + err: + if (listPtr != argv[1]) { + Jim_FreeNewObj(interp, listPtr); + } + return JIM_ERR; +} + + +static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int first, last, len, rangeLen; + Jim_Obj *listObj; + Jim_Obj *newListObj; + + if (argc < 4) { + Jim_WrongNumArgs(interp, 1, argv, "list first last ?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]; + len = Jim_ListLength(interp, listObj); + + first = JimRelToAbsIndex(len, first); + last = JimRelToAbsIndex(len, last); + JimRelToAbsRange(len, &first, &last, &rangeLen); + + + if (first > len) { + first = len; + } + + + newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first); + + + ListInsertElements(newListObj, -1, argc - 4, argv + 4); + + + ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen); + + Jim_SetResult(interp, newListObj); + return JIM_OK; +} + + +static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal"); + return JIM_ERR; + } + else if (argc == 3) { + + if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK) + return JIM_ERR; + Jim_SetResult(interp, argv[2]); + return JIM_OK; + } + return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]); +} + + +static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[]) +{ + static const char * const options[] = { + "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL + }; + enum + { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE }; + Jim_Obj *resObj; + int i; + int retCode; + int shared; + + struct lsort_info info; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "?options? list"); + return JIM_ERR; + } + + info.type = JIM_LSORT_ASCII; + info.order = 1; + info.indexed = 0; + info.unique = 0; + info.command = NULL; + info.interp = interp; + + for (i = 1; i < (argc - 1); i++) { + int option; + + if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG) + != JIM_OK) + return JIM_ERR; + switch (option) { + case OPT_ASCII: + info.type = JIM_LSORT_ASCII; + break; + case OPT_NOCASE: + info.type = JIM_LSORT_NOCASE; + break; + case OPT_INTEGER: + info.type = JIM_LSORT_INTEGER; + break; + case OPT_REAL: + info.type = JIM_LSORT_REAL; + break; + case OPT_INCREASING: + info.order = 1; + break; + case OPT_DECREASING: + info.order = -1; + break; + case OPT_UNIQUE: + info.unique = 1; + break; + case OPT_COMMAND: + if (i >= (argc - 2)) { + Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1); + return JIM_ERR; + } + info.type = JIM_LSORT_COMMAND; + info.command = argv[i + 1]; + i++; + break; + case OPT_INDEX: + if (i >= (argc - 2)) { + Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1); + return JIM_ERR; + } + if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) { + return JIM_ERR; + } + info.indexed = 1; + i++; + break; + } + } + resObj = argv[argc - 1]; + if ((shared = Jim_IsShared(resObj))) + resObj = Jim_DuplicateObj(interp, resObj); + retCode = ListSortElements(interp, resObj, &info); + if (retCode == JIM_OK) { + Jim_SetResult(interp, resObj); + } + else if (shared) { + Jim_FreeNewObj(interp, resObj); + } + return retCode; +} + + +static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *stringObjPtr; + int i; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?"); + return JIM_ERR; + } + if (argc == 2) { + stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG); + if (!stringObjPtr) + return JIM_ERR; + } + else { + int new_obj = 0; + stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED); + if (!stringObjPtr) { + + stringObjPtr = Jim_NewEmptyStringObj(interp); + new_obj = 1; + } + else if (Jim_IsShared(stringObjPtr)) { + new_obj = 1; + stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr); + } + for (i = 2; i < argc; i++) { + Jim_AppendObj(interp, stringObjPtr, argv[i]); + } + if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) { + if (new_obj) { + Jim_FreeNewObj(interp, stringObjPtr); + } + return JIM_ERR; + } + } + Jim_SetResult(interp, stringObjPtr); + return JIM_OK; +} + + + +static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ +#if !defined(JIM_DEBUG_COMMAND) + Jim_SetResultString(interp, "unsupported", -1); + return JIM_ERR; +#endif +} + + +static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int rc; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?"); + return JIM_ERR; + } + + if (argc == 2) { + rc = Jim_EvalObj(interp, argv[1]); + } + else { + rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1)); + } + + if (rc == JIM_ERR) { + + interp->addStackTrace++; + } + return rc; +} + + +static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc >= 2) { + int retcode; + Jim_CallFrame *savedCallFrame, *targetCallFrame; + const char *str; + + + savedCallFrame = interp->framePtr; + + + str = Jim_String(argv[1]); + if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') { + targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]); + argc--; + argv++; + } + else { + targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL); + } + if (targetCallFrame == NULL) { + return JIM_ERR; + } + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?"); + return JIM_ERR; + } + + interp->framePtr = targetCallFrame; + if (argc == 2) { + retcode = Jim_EvalObj(interp, argv[1]); + } + else { + retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1)); + } + interp->framePtr = savedCallFrame; + return retcode; + } + else { + Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?"); + return JIM_ERR; + } +} + + +static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retcode; + + if (argc == 2) { + retcode = Jim_EvalExpression(interp, argv[1]); + } + else if (argc > 2) { + Jim_Obj *objPtr; + + objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1); + Jim_IncrRefCount(objPtr); + retcode = Jim_EvalExpression(interp, objPtr); + Jim_DecrRefCount(interp, objPtr); + } + else { + Jim_WrongNumArgs(interp, 1, argv, "expression ?...?"); + return JIM_ERR; + } + if (retcode != JIM_OK) + return retcode; + return JIM_OK; +} + + +static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 1) { + Jim_WrongNumArgs(interp, 1, argv, ""); + return JIM_ERR; + } + return JIM_BREAK; +} + + +static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 1) { + Jim_WrongNumArgs(interp, 1, argv, ""); + return JIM_ERR; + } + return JIM_CONTINUE; +} + + +static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + Jim_Obj *stackTraceObj = NULL; + Jim_Obj *errorCodeObj = NULL; + int returnCode = JIM_OK; + long level = 1; + + for (i = 1; i < argc - 1; i += 2) { + if (Jim_CompareStringImmediate(interp, argv[i], "-code")) { + if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) { + return JIM_ERR; + } + } + else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) { + stackTraceObj = argv[i + 1]; + } + else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) { + errorCodeObj = argv[i + 1]; + } + else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) { + if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) { + Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]); + return JIM_ERR; + } + } + else { + break; + } + } + + if (i != argc - 1 && i != argc) { + Jim_WrongNumArgs(interp, 1, argv, + "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?"); + } + + + if (stackTraceObj && returnCode == JIM_ERR) { + JimSetStackTrace(interp, stackTraceObj); + } + + if (errorCodeObj && returnCode == JIM_ERR) { + Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj); + } + interp->returnCode = returnCode; + interp->returnLevel = level; + + if (i == argc - 1) { + Jim_SetResult(interp, argv[i]); + } + return JIM_RETURN; +} + + +static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (interp->framePtr->level == 0) { + Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1); + return JIM_ERR; + } + else if (argc >= 2) { + + Jim_CallFrame *cf = interp->framePtr->parent; + + Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG); + if (cmdPtr == NULL) { + return JIM_ERR; + } + + JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd")); + + + JimIncrCmdRefCount(cmdPtr); + cf->tailcallCmd = cmdPtr; + + + JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj")); + + cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1); + Jim_IncrRefCount(cf->tailcallObj); + + + return JIM_EVAL; + } + return JIM_OK; +} + +static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *cmdList; + Jim_Obj *prefixListObj = Jim_CmdPrivData(interp); + + + cmdList = Jim_DuplicateObj(interp, prefixListObj); + Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1); + + return JimEvalObjList(interp, cmdList); +} + +static void JimAliasCmdDelete(Jim_Interp *interp, void *privData) +{ + Jim_Obj *prefixListObj = privData; + Jim_DecrRefCount(interp, prefixListObj); +} + +static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *prefixListObj; + const char *newname; + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?"); + return JIM_ERR; + } + + prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2); + Jim_IncrRefCount(prefixListObj); + newname = Jim_String(argv[1]); + if (newname[0] == ':' && newname[1] == ':') { + while (*++newname == ':') { + } + } + + Jim_SetResult(interp, argv[1]); + + return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete); +} + + +static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Cmd *cmd; + + if (argc != 4 && argc != 5) { + Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body"); + return JIM_ERR; + } + + if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) { + return JIM_ERR; + } + + if (argc == 4) { + cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL); + } + else { + cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL); + } + + if (cmd) { + + Jim_Obj *qualifiedCmdNameObj; + const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj); + + JimCreateCommand(interp, cmdname, cmd); + + + JimUpdateProcNamespace(interp, cmd, cmdname); + + JimFreeQualifiedName(interp, qualifiedCmdNameObj); + + + Jim_SetResult(interp, argv[1]); + return JIM_OK; + } + return JIM_ERR; +} + + +static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retcode; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?"); + return JIM_ERR; + } + + + interp->local++; + retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1); + interp->local--; + + + + if (retcode == 0) { + Jim_Obj *cmdNameObj = Jim_GetResult(interp); + + if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) { + return JIM_ERR; + } + if (interp->framePtr->localCommands == NULL) { + interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands)); + Jim_InitStack(interp->framePtr->localCommands); + } + Jim_IncrRefCount(cmdNameObj); + Jim_StackPush(interp->framePtr->localCommands, cmdNameObj); + } + + return retcode; +} + + +static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?"); + return JIM_ERR; + } + else { + int retcode; + + Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG); + if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) { + Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]); + return JIM_ERR; + } + + cmdPtr->u.proc.upcall++; + JimIncrCmdRefCount(cmdPtr); + + + retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1); + + + cmdPtr->u.proc.upcall--; + JimDecrCmdRefCount(interp, cmdPtr); + + return retcode; + } +} + + +static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?"); + return JIM_ERR; + } + else { + int ret; + Jim_Cmd *cmd; + Jim_Obj *argListObjPtr; + Jim_Obj *bodyObjPtr; + Jim_Obj *nsObj = NULL; + Jim_Obj **nargv; + + int len = Jim_ListLength(interp, argv[1]); + if (len != 2 && len != 3) { + Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]); + return JIM_ERR; + } + + if (len == 3) { +#ifdef jim_ext_namespace + + nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2)); +#else + Jim_SetResultString(interp, "namespaces not enabled", -1); + return JIM_ERR; +#endif + } + argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0); + bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1); + + cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj); + + if (cmd) { + + nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv)); + nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1); + Jim_IncrRefCount(nargv[0]); + memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv)); + ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv); + Jim_DecrRefCount(interp, nargv[0]); + Jim_Free(nargv); + + JimDecrCmdRefCount(interp, cmd); + return ret; + } + return JIM_ERR; + } +} + + + +static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1)); + return JIM_OK; +} + + +static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + Jim_CallFrame *targetCallFrame; + + + if (argc > 3 && (argc % 2 == 0)) { + targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]); + argc--; + argv++; + } + else { + targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL); + } + if (targetCallFrame == NULL) { + return JIM_ERR; + } + + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?"); + return JIM_ERR; + } + + + for (i = 1; i < argc; i += 2) { + if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK) + return JIM_ERR; + } + return JIM_OK; +} + + +static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?"); + return JIM_ERR; + } + + if (interp->framePtr->level == 0) + return JIM_OK; + for (i = 1; i < argc; i++) { + + const char *name = Jim_String(argv[i]); + if (name[0] != ':' || name[1] != ':') { + if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK) + return JIM_ERR; + } + } + return JIM_OK; +} + +static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr, + Jim_Obj *objPtr, int nocase) +{ + int numMaps; + const char *str, *noMatchStart = NULL; + int strLen, i; + Jim_Obj *resultObjPtr; + + numMaps = Jim_ListLength(interp, mapListObjPtr); + if (numMaps % 2) { + Jim_SetResultString(interp, "list must contain an even number of elements", -1); + return NULL; + } + + str = Jim_String(objPtr); + strLen = Jim_Utf8Length(interp, objPtr); + + + resultObjPtr = Jim_NewStringObj(interp, "", 0); + while (strLen) { + for (i = 0; i < numMaps; i += 2) { + Jim_Obj *eachObjPtr; + const char *k; + int kl; + + eachObjPtr = Jim_ListGetIndex(interp, mapListObjPtr, i); + k = Jim_String(eachObjPtr); + kl = Jim_Utf8Length(interp, eachObjPtr); + + if (strLen >= kl && kl) { + int rc; + rc = JimStringCompareLen(str, k, kl, nocase); + if (rc == 0) { + if (noMatchStart) { + Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart); + noMatchStart = NULL; + } + Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1)); + str += utf8_index(str, kl); + strLen -= kl; + break; + } + } + } + if (i == numMaps) { + int c; + if (noMatchStart == NULL) + noMatchStart = str; + str += utf8_tounicode(str, &c); + strLen--; + } + } + if (noMatchStart) { + Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart); + } + return resultObjPtr; +} + + +static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int len; + int opt_case = 1; + int option; + static const char * const options[] = { + "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace", + "map", "repeat", "reverse", "index", "first", "last", "cat", + "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL + }; + enum + { + OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE, + OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT, + OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE + }; + static const char * const nocase_options[] = { + "-nocase", NULL + }; + static const char * const nocase_length_options[] = { + "-nocase", "-length", NULL + }; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?"); + return JIM_ERR; + } + if (Jim_GetEnum(interp, argv[1], options, &option, NULL, + JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) + return Jim_CheckShowCommands(interp, argv[1], options); + + switch (option) { + case OPT_LENGTH: + case OPT_BYTELENGTH: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "string"); + return JIM_ERR; + } + if (option == OPT_LENGTH) { + len = Jim_Utf8Length(interp, argv[2]); + } + else { + len = Jim_Length(argv[2]); + } + Jim_SetResultInt(interp, len); + return JIM_OK; + + case OPT_CAT:{ + Jim_Obj *objPtr; + if (argc == 3) { + + objPtr = argv[2]; + } + else { + int i; + + objPtr = Jim_NewStringObj(interp, "", 0); + + for (i = 2; i < argc; i++) { + Jim_AppendObj(interp, objPtr, argv[i]); + } + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + case OPT_COMPARE: + case OPT_EQUAL: + { + + long opt_length = -1; + int n = argc - 4; + int i = 2; + while (n > 0) { + int subopt; + if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL, + JIM_ENUM_ABBREV) != JIM_OK) { +badcompareargs: + Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2"); + return JIM_ERR; + } + if (subopt == 0) { + + opt_case = 0; + n--; + } + else { + + if (n < 2) { + goto badcompareargs; + } + if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) { + return JIM_ERR; + } + n -= 2; + } + } + if (n) { + goto badcompareargs; + } + argv += argc - 2; + if (opt_length < 0 && option != OPT_COMPARE && opt_case) { + + Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1])); + } + else { + if (opt_length >= 0) { + n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case); + } + else { + n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case); + } + Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0); + } + return JIM_OK; + } + + case OPT_MATCH: + if (argc != 4 && + (argc != 5 || + Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL, + JIM_ENUM_ABBREV) != JIM_OK)) { + Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string"); + return JIM_ERR; + } + if (opt_case == 0) { + argv++; + } + Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case)); + return JIM_OK; + + case OPT_MAP:{ + Jim_Obj *objPtr; + + if (argc != 4 && + (argc != 5 || + Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL, + JIM_ENUM_ABBREV) != JIM_OK)) { + Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string"); + return JIM_ERR; + } + + if (opt_case == 0) { + argv++; + } + objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case); + if (objPtr == NULL) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + case OPT_RANGE: + case OPT_BYTERANGE:{ + Jim_Obj *objPtr; + + if (argc != 5) { + Jim_WrongNumArgs(interp, 2, argv, "string first last"); + return JIM_ERR; + } + if (option == OPT_RANGE) { + objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]); + } + else + { + objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]); + } + + if (objPtr == NULL) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + case OPT_REPLACE:{ + Jim_Obj *objPtr; + + if (argc != 5 && argc != 6) { + Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?"); + return JIM_ERR; + } + objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL); + if (objPtr == NULL) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + + case OPT_REPEAT:{ + Jim_Obj *objPtr; + jim_wide count; + + if (argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "string count"); + return JIM_ERR; + } + if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) { + return JIM_ERR; + } + objPtr = Jim_NewStringObj(interp, "", 0); + if (count > 0) { + while (count--) { + Jim_AppendObj(interp, objPtr, argv[2]); + } + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + case OPT_REVERSE:{ + char *buf, *p; + const char *str; + int i; + + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "string"); + return JIM_ERR; + } + + str = Jim_GetString(argv[2], &len); + buf = Jim_Alloc(len + 1); + p = buf + len; + *p = 0; + for (i = 0; i < len; ) { + int c; + int l = utf8_tounicode(str, &c); + memcpy(p - l, str, l); + p -= l; + i += l; + str += l; + } + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len)); + return JIM_OK; + } + + case OPT_INDEX:{ + int idx; + const char *str; + + if (argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "string index"); + return JIM_ERR; + } + if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) { + return JIM_ERR; + } + str = Jim_String(argv[2]); + len = Jim_Utf8Length(interp, argv[2]); + if (idx != INT_MIN && idx != INT_MAX) { + idx = JimRelToAbsIndex(len, idx); + } + if (idx < 0 || idx >= len || str == NULL) { + Jim_SetResultString(interp, "", 0); + } + else if (len == Jim_Length(argv[2])) { + + Jim_SetResultString(interp, str + idx, 1); + } + else { + int c; + int i = utf8_index(str, idx); + Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c)); + } + return JIM_OK; + } + + case OPT_FIRST: + case OPT_LAST:{ + int idx = 0, l1, l2; + const char *s1, *s2; + + if (argc != 4 && argc != 5) { + Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?"); + return JIM_ERR; + } + s1 = Jim_String(argv[2]); + s2 = Jim_String(argv[3]); + l1 = Jim_Utf8Length(interp, argv[2]); + l2 = Jim_Utf8Length(interp, argv[3]); + if (argc == 5) { + if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) { + return JIM_ERR; + } + idx = JimRelToAbsIndex(l2, idx); + } + else if (option == OPT_LAST) { + idx = l2; + } + if (option == OPT_FIRST) { + Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx)); + } + else { +#ifdef JIM_UTF8 + Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx)); +#else + Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx)); +#endif + } + return JIM_OK; + } + + case OPT_TRIM: + case OPT_TRIMLEFT: + case OPT_TRIMRIGHT:{ + Jim_Obj *trimchars; + + if (argc != 3 && argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?"); + return JIM_ERR; + } + trimchars = (argc == 4 ? argv[3] : NULL); + if (option == OPT_TRIM) { + Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars)); + } + else if (option == OPT_TRIMLEFT) { + Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars)); + } + else if (option == OPT_TRIMRIGHT) { + Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars)); + } + return JIM_OK; + } + + case OPT_TOLOWER: + case OPT_TOUPPER: + case OPT_TOTITLE: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "string"); + return JIM_ERR; + } + if (option == OPT_TOLOWER) { + Jim_SetResult(interp, JimStringToLower(interp, argv[2])); + } + else if (option == OPT_TOUPPER) { + Jim_SetResult(interp, JimStringToUpper(interp, argv[2])); + } + else { + Jim_SetResult(interp, JimStringToTitle(interp, argv[2])); + } + return JIM_OK; + + case OPT_IS: + if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) { + return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5); + } + Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str"); + return JIM_ERR; + } + return JIM_OK; +} + + +static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + long i, count = 1; + jim_wide start, elapsed; + char buf[60]; + const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration"; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "script ?count?"); + return JIM_ERR; + } + if (argc == 3) { + if (Jim_GetLong(interp, argv[2], &count) != JIM_OK) + return JIM_ERR; + } + if (count < 0) + return JIM_OK; + i = count; + start = JimClock(); + while (i-- > 0) { + int retval; + + retval = Jim_EvalObj(interp, argv[1]); + if (retval != JIM_OK) { + return retval; + } + } + elapsed = JimClock() - start; + sprintf(buf, fmt, count == 0 ? 0 : elapsed / count); + Jim_SetResultString(interp, buf, -1); + return JIM_OK; +} + + +static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + long exitCode = 0; + + if (argc > 2) { + Jim_WrongNumArgs(interp, 1, argv, "?exitCode?"); + return JIM_ERR; + } + if (argc == 2) { + if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK) + return JIM_ERR; + } + interp->exitCode = exitCode; + return JIM_EXIT; +} + + +static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int exitCode = 0; + int i; + int sig = 0; + + + jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL); + static const int max_ignore_code = sizeof(ignore_mask) * 8; + + Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1)); + + for (i = 1; i < argc - 1; i++) { + const char *arg = Jim_String(argv[i]); + jim_wide option; + int ignore; + + + if (strcmp(arg, "--") == 0) { + i++; + break; + } + if (*arg != '-') { + break; + } + + if (strncmp(arg, "-no", 3) == 0) { + arg += 3; + ignore = 1; + } + else { + arg++; + ignore = 0; + } + + if (Jim_StringToWide(arg, &option, 10) != JIM_OK) { + option = -1; + } + if (option < 0) { + option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize); + } + if (option < 0) { + goto wrongargs; + } + + if (ignore) { + ignore_mask |= ((jim_wide)1 << option); + } + else { + ignore_mask &= (~((jim_wide)1 << option)); + } + } + + argc -= i; + if (argc < 1 || argc > 3) { + wrongargs: + Jim_WrongNumArgs(interp, 1, argv, + "?-?no?code ... --? script ?resultVarName? ?optionVarName?"); + return JIM_ERR; + } + argv += i; + + if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) { + sig++; + } + + interp->signal_level += sig; + if (Jim_CheckSignal(interp)) { + + exitCode = JIM_SIGNAL; + } + else { + exitCode = Jim_EvalObj(interp, argv[0]); + + interp->errorFlag = 0; + } + interp->signal_level -= sig; + + + if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) { + + return exitCode; + } + + if (sig && exitCode == JIM_SIGNAL) { + + if (interp->signal_set_result) { + interp->signal_set_result(interp, interp->sigmask); + } + else { + Jim_SetResultInt(interp, interp->sigmask); + } + interp->sigmask = 0; + } + + if (argc >= 2) { + if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) { + return JIM_ERR; + } + if (argc == 3) { + Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0); + + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1)); + Jim_ListAppendElement(interp, optListObj, + Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode)); + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1)); + Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel)); + if (exitCode == JIM_ERR) { + Jim_Obj *errorCode; + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo", + -1)); + Jim_ListAppendElement(interp, optListObj, interp->stackTrace); + + errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE); + if (errorCode) { + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1)); + Jim_ListAppendElement(interp, optListObj, errorCode); + } + } + if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) { + return JIM_ERR; + } + } + } + Jim_SetResultInt(interp, exitCode); + return JIM_OK; +} + + + +static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "oldName newName"); + return JIM_ERR; + } + + if (JimValidName(interp, "new procedure", argv[2])) { + return JIM_ERR; + } + + return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2])); +} + +#define JIM_DICTMATCH_KEYS 0x0001 +#define JIM_DICTMATCH_VALUES 0x002 + +int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types) +{ + Jim_HashEntry *he; + Jim_Obj *listObjPtr; + Jim_HashTableIterator htiter; + + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return JIM_ERR; + } + + listObjPtr = Jim_NewListObj(interp, NULL, 0); + + JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter); + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + if (patternObj) { + Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he); + if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) { + + continue; + } + } + if (return_types & JIM_DICTMATCH_KEYS) { + Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key); + } + if (return_types & JIM_DICTMATCH_VALUES) { + Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he)); + } + } + + Jim_SetResult(interp, listObjPtr); + return JIM_OK; +} + +int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return -1; + } + return ((Jim_HashTable *)objPtr->internalRep.ptr)->used; +} + +Jim_Obj *Jim_DictMerge(Jim_Interp *interp, int objc, Jim_Obj *const *objv) +{ + Jim_Obj *objPtr = Jim_NewDictObj(interp, NULL, 0); + int i; + + JimPanic((objc == 0, "Jim_DictMerge called with objc=0")); + + + + for (i = 0; i < objc; i++) { + Jim_HashTable *ht; + Jim_HashTableIterator htiter; + Jim_HashEntry *he; + + if (SetDictFromAny(interp, objv[i]) != JIM_OK) { + Jim_FreeNewObj(interp, objPtr); + return NULL; + } + ht = objv[i]->internalRep.ptr; + JimInitHashTableIterator(ht, &htiter); + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he)); + } + } + return objPtr; +} + +int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_HashTable *ht; + unsigned int i; + char buffer[100]; + int sum = 0; + int nonzero_count = 0; + Jim_Obj *output; + int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; + + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return JIM_ERR; + } + + ht = (Jim_HashTable *)objPtr->internalRep.ptr; + + + snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size); + output = Jim_NewStringObj(interp, buffer, -1); + + for (i = 0; i < ht->size; i++) { + Jim_HashEntry *he = ht->table[i]; + int entries = 0; + while (he) { + entries++; + he = he->next; + } + if (entries > 9) { + bucket_counts[10]++; + } + else { + bucket_counts[entries]++; + } + if (entries) { + sum += entries; + nonzero_count++; + } + } + for (i = 0; i < 10; i++) { + snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]); + Jim_AppendString(interp, output, buffer, -1); + } + snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]); + Jim_AppendString(interp, output, buffer, -1); + snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0); + Jim_AppendString(interp, output, buffer, -1); + Jim_SetResult(interp, output); + return JIM_OK; +} + +static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1); + + Jim_AppendString(interp, prefixObj, " ", 1); + Jim_AppendString(interp, prefixObj, subcmd, -1); + + return Jim_EvalObjPrefix(interp, prefixObj, argc, argv); +} + +static int JimDictWith(Jim_Interp *interp, Jim_Obj *dictVarName, Jim_Obj *const *keyv, int keyc, Jim_Obj *scriptObj) +{ + int i; + Jim_Obj *objPtr; + Jim_Obj *dictObj; + Jim_Obj **dictValues; + int len; + int ret = JIM_OK; + + + dictObj = Jim_GetVariable(interp, dictVarName, JIM_ERRMSG); + if (dictObj == NULL || Jim_DictKeysVector(interp, dictObj, keyv, keyc, &objPtr, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + + if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) { + return JIM_ERR; + } + for (i = 0; i < len; i += 2) { + if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) { + Jim_Free(dictValues); + return JIM_ERR; + } + } + + + if (Jim_Length(scriptObj)) { + ret = Jim_EvalObj(interp, scriptObj); + + + if (ret == JIM_OK && Jim_GetVariable(interp, dictVarName, 0) != NULL) { + + Jim_Obj **newkeyv = Jim_Alloc(sizeof(*newkeyv) * (keyc + 1)); + for (i = 0; i < keyc; i++) { + newkeyv[i] = keyv[i]; + } + + for (i = 0; i < len; i += 2) { + + objPtr = Jim_GetVariable(interp, dictValues[i], 0); + newkeyv[keyc] = dictValues[i]; + Jim_SetDictKeysVector(interp, dictVarName, newkeyv, keyc + 1, objPtr, 0); + } + Jim_Free(newkeyv); + } + } + + Jim_Free(dictValues); + + return ret; +} + + +static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + int types = JIM_DICTMATCH_KEYS; + int option; + static const char * const options[] = { + "create", "get", "set", "unset", "exists", "keys", "size", "info", + "merge", "with", "append", "lappend", "incr", "remove", "values", "for", + "replace", "update", NULL + }; + enum + { + OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO, + OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR, + OPT_REPLACE, OPT_UPDATE, + }; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?"); + return JIM_ERR; + } + + if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) { + return Jim_CheckShowCommands(interp, argv[1], options); + } + + switch (option) { + case OPT_GET: + if (argc < 3) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?"); + return JIM_ERR; + } + if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, + JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + + case OPT_SET: + if (argc < 5) { + Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value"); + return JIM_ERR; + } + return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG); + + case OPT_EXISTS: + if (argc < 4) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?"); + return JIM_ERR; + } + else { + int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG); + if (rc < 0) { + return JIM_ERR; + } + Jim_SetResultBool(interp, rc == JIM_OK); + return JIM_OK; + } + + case OPT_UNSET: + if (argc < 4) { + Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?"); + return JIM_ERR; + } + if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) { + return JIM_ERR; + } + return JIM_OK; + + case OPT_VALUES: + types = JIM_DICTMATCH_VALUES; + + case OPT_KEYS: + if (argc != 3 && argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?"); + return JIM_ERR; + } + return Jim_DictMatchTypes(interp, argv[2], argc == 4 ? argv[3] : NULL, types, types); + + case OPT_SIZE: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary"); + return JIM_ERR; + } + else if (Jim_DictSize(interp, argv[2]) < 0) { + return JIM_ERR; + } + Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2])); + return JIM_OK; + + case OPT_MERGE: + if (argc == 2) { + return JIM_OK; + } + objPtr = Jim_DictMerge(interp, argc - 2, argv + 2); + if (objPtr == NULL) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + + case OPT_UPDATE: + if (argc < 6 || argc % 2) { + + argc = 2; + } + break; + + case OPT_CREATE: + if (argc % 2) { + Jim_WrongNumArgs(interp, 2, argv, "?key value ...?"); + return JIM_ERR; + } + objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2); + Jim_SetResult(interp, objPtr); + return JIM_OK; + + case OPT_INFO: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary"); + return JIM_ERR; + } + return Jim_DictInfo(interp, argv[2]); + + case OPT_WITH: + if (argc < 4) { + Jim_WrongNumArgs(interp, 2, argv, "dictVar ?key ...? script"); + return JIM_ERR; + } + return JimDictWith(interp, argv[2], argv + 3, argc - 4, argv[argc - 1]); + } + + return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2); +} + + +static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + static const char * const options[] = { + "-nobackslashes", "-nocommands", "-novariables", NULL + }; + enum + { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES }; + int i; + int flags = JIM_SUBST_FLAG; + Jim_Obj *objPtr; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "?options? string"); + return JIM_ERR; + } + for (i = 1; i < (argc - 1); i++) { + int option; + + if (Jim_GetEnum(interp, argv[i], options, &option, NULL, + JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_NOBACKSLASHES: + flags |= JIM_SUBST_NOESC; + break; + case OPT_NOCOMMANDS: + flags |= JIM_SUBST_NOCMD; + break; + case OPT_NOVARIABLES: + flags |= JIM_SUBST_NOVAR; + break; + } + } + if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + + +static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int cmd; + Jim_Obj *objPtr; + int mode = 0; + + static const char * const commands[] = { + "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals", + "vars", "version", "patchlevel", "complete", "args", "hostname", + "script", "source", "stacktrace", "nameofexecutable", "returncodes", + "references", "alias", NULL + }; + enum + { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL, + INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS, + INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE, + INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS, + }; + +#ifdef jim_ext_namespace + int nons = 0; + + if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) { + + argc--; + argv++; + nons = 1; + } +#endif + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?"); + return JIM_ERR; + } + if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return Jim_CheckShowCommands(interp, argv[1], commands); + } + + + switch (cmd) { + case INFO_EXISTS: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "varName"); + return JIM_ERR; + } + Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL); + break; + + case INFO_ALIAS:{ + Jim_Cmd *cmdPtr; + + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "command"); + return JIM_ERR; + } + if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) { + return JIM_ERR; + } + if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) { + Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]); + return JIM_ERR; + } + Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData); + return JIM_OK; + } + + case INFO_CHANNELS: + mode++; +#ifndef jim_ext_aio + Jim_SetResultString(interp, "aio not enabled", -1); + return JIM_ERR; +#endif + + case INFO_PROCS: + mode++; + + case INFO_COMMANDS: + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "?pattern?"); + return JIM_ERR; + } +#ifdef jim_ext_namespace + if (!nons) { + if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) { + return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1); + } + } +#endif + Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode)); + break; + + case INFO_VARS: + mode++; + + case INFO_LOCALS: + mode++; + + case INFO_GLOBALS: + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "?pattern?"); + return JIM_ERR; + } +#ifdef jim_ext_namespace + if (!nons) { + if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) { + return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1); + } + } +#endif + Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode)); + break; + + case INFO_SCRIPT: + if (argc != 2) { + Jim_WrongNumArgs(interp, 2, argv, ""); + return JIM_ERR; + } + Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj); + break; + + case INFO_SOURCE:{ + jim_wide line; + Jim_Obj *resObjPtr; + Jim_Obj *fileNameObj; + + if (argc != 3 && argc != 5) { + Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?"); + return JIM_ERR; + } + if (argc == 5) { + if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) { + return JIM_ERR; + } + resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2])); + JimSetSourceInfo(interp, resObjPtr, argv[3], line); + } + else { + if (argv[2]->typePtr == &sourceObjType) { + fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj; + line = argv[2]->internalRep.sourceValue.lineNumber; + } + else if (argv[2]->typePtr == &scriptObjType) { + ScriptObj *script = JimGetScript(interp, argv[2]); + fileNameObj = script->fileNameObj; + line = script->firstline; + } + else { + fileNameObj = interp->emptyObj; + line = 1; + } + resObjPtr = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, resObjPtr, fileNameObj); + Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line)); + } + Jim_SetResult(interp, resObjPtr); + break; + } + + case INFO_STACKTRACE: + Jim_SetResult(interp, interp->stackTrace); + break; + + case INFO_LEVEL: + case INFO_FRAME: + switch (argc) { + case 2: + Jim_SetResultInt(interp, interp->framePtr->level); + break; + + case 3: + if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + break; + + default: + Jim_WrongNumArgs(interp, 2, argv, "?levelNum?"); + return JIM_ERR; + } + break; + + case INFO_BODY: + case INFO_STATICS: + case INFO_ARGS:{ + Jim_Cmd *cmdPtr; + + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "procname"); + return JIM_ERR; + } + if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) { + return JIM_ERR; + } + if (!cmdPtr->isproc) { + Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]); + return JIM_ERR; + } + switch (cmd) { + case INFO_BODY: + Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr); + break; + case INFO_ARGS: + Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr); + break; + case INFO_STATICS: + if (cmdPtr->u.proc.staticVars) { + Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars, + NULL, JimVariablesMatch, JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES)); + } + break; + } + break; + } + + case INFO_VERSION: + case INFO_PATCHLEVEL:{ + char buf[(JIM_INTEGER_SPACE * 2) + 1]; + + sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100); + Jim_SetResultString(interp, buf, -1); + break; + } + + case INFO_COMPLETE: + if (argc != 3 && argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "script ?missing?"); + return JIM_ERR; + } + else { + char missing; + + Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing)); + if (missing != ' ' && argc == 4) { + Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1)); + } + } + break; + + case INFO_HOSTNAME: + + return Jim_Eval(interp, "os.gethostname"); + + case INFO_NAMEOFEXECUTABLE: + + return Jim_Eval(interp, "{info nameofexecutable}"); + + case INFO_RETURNCODES: + if (argc == 2) { + int i; + Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0); + + for (i = 0; jimReturnCodes[i]; i++) { + Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i)); + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, + jimReturnCodes[i], -1)); + } + + Jim_SetResult(interp, listObjPtr); + } + else if (argc == 3) { + long code; + const char *name; + + if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) { + return JIM_ERR; + } + name = Jim_ReturnCode(code); + if (*name == '?') { + Jim_SetResultInt(interp, code); + } + else { + Jim_SetResultString(interp, name, -1); + } + } + else { + Jim_WrongNumArgs(interp, 2, argv, "?code?"); + return JIM_ERR; + } + break; + case INFO_REFERENCES: +#ifdef JIM_REFERENCES + return JimInfoReferences(interp, argc, argv); +#else + Jim_SetResultString(interp, "not supported", -1); + return JIM_ERR; +#endif + } + return JIM_OK; +} + + +static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + int result = 0; + + static const char * const options[] = { + "-command", "-proc", "-alias", "-var", NULL + }; + enum + { + OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR + }; + int option; + + if (argc == 2) { + option = OPT_VAR; + objPtr = argv[1]; + } + else if (argc == 3) { + if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + objPtr = argv[2]; + } + else { + Jim_WrongNumArgs(interp, 1, argv, "?option? name"); + return JIM_ERR; + } + + if (option == OPT_VAR) { + result = Jim_GetVariable(interp, objPtr, 0) != NULL; + } + else { + + Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE); + + if (cmd) { + switch (option) { + case OPT_COMMAND: + result = 1; + break; + + case OPT_ALIAS: + result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd; + break; + + case OPT_PROC: + result = cmd->isproc; + break; + } + } + } + Jim_SetResultBool(interp, result); + return JIM_OK; +} + + +static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *str, *splitChars, *noMatchStart; + int splitLen, strLen; + Jim_Obj *resObjPtr; + int c; + int len; + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?"); + return JIM_ERR; + } + + str = Jim_GetString(argv[1], &len); + if (len == 0) { + return JIM_OK; + } + strLen = Jim_Utf8Length(interp, argv[1]); + + + if (argc == 2) { + splitChars = " \n\t\r"; + splitLen = 4; + } + else { + splitChars = Jim_String(argv[2]); + splitLen = Jim_Utf8Length(interp, argv[2]); + } + + noMatchStart = str; + resObjPtr = Jim_NewListObj(interp, NULL, 0); + + + if (splitLen) { + Jim_Obj *objPtr; + while (strLen--) { + const char *sc = splitChars; + int scLen = splitLen; + int sl = utf8_tounicode(str, &c); + while (scLen--) { + int pc; + sc += utf8_tounicode(sc, &pc); + if (c == pc) { + objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart)); + Jim_ListAppendElement(interp, resObjPtr, objPtr); + noMatchStart = str + sl; + break; + } + } + str += sl; + } + objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart)); + Jim_ListAppendElement(interp, resObjPtr, objPtr); + } + else { + Jim_Obj **commonObj = NULL; +#define NUM_COMMON (128 - 9) + while (strLen--) { + int n = utf8_tounicode(str, &c); +#ifdef JIM_OPTIMIZATION + if (c >= 9 && c < 128) { + + c -= 9; + if (!commonObj) { + commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON); + memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON); + } + if (!commonObj[c]) { + commonObj[c] = Jim_NewStringObj(interp, str, 1); + } + Jim_ListAppendElement(interp, resObjPtr, commonObj[c]); + str++; + continue; + } +#endif + Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1)); + str += n; + } + Jim_Free(commonObj); + } + + Jim_SetResult(interp, resObjPtr); + return JIM_OK; +} + + +static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *joinStr; + int joinStrLen; + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?"); + return JIM_ERR; + } + + if (argc == 2) { + joinStr = " "; + joinStrLen = 1; + } + else { + joinStr = Jim_GetString(argv[2], &joinStrLen); + } + Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen)); + return JIM_OK; +} + + +static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?"); + return JIM_ERR; + } + objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2); + if (objPtr == NULL) + return JIM_ERR; + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + + +static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *listPtr, **outVec; + int outc, i; + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?"); + return JIM_ERR; + } + if (argv[2]->typePtr != &scanFmtStringObjType) + SetScanFmtFromAny(interp, argv[2]); + if (FormatGetError(argv[2]) != 0) { + Jim_SetResultString(interp, FormatGetError(argv[2]), -1); + return JIM_ERR; + } + if (argc > 3) { + int maxPos = FormatGetMaxPos(argv[2]); + int count = FormatGetCnvCount(argv[2]); + + if (maxPos > argc - 3) { + Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1); + return JIM_ERR; + } + else if (count > argc - 3) { + Jim_SetResultString(interp, "different numbers of variable names and " + "field specifiers", -1); + return JIM_ERR; + } + else if (count < argc - 3) { + Jim_SetResultString(interp, "variable is not assigned by any " + "conversion specifiers", -1); + return JIM_ERR; + } + } + listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG); + if (listPtr == 0) + return JIM_ERR; + if (argc > 3) { + int rc = JIM_OK; + int count = 0; + + if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) { + int len = Jim_ListLength(interp, listPtr); + + if (len != 0) { + JimListGetElements(interp, listPtr, &outc, &outVec); + for (i = 0; i < outc; ++i) { + if (Jim_Length(outVec[i]) > 0) { + ++count; + if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) { + rc = JIM_ERR; + } + } + } + } + Jim_FreeNewObj(interp, listPtr); + } + else { + count = -1; + } + if (rc == JIM_OK) { + Jim_SetResultInt(interp, count); + } + return rc; + } + else { + if (listPtr == (Jim_Obj *)EOF) { + Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0)); + return JIM_OK; + } + Jim_SetResult(interp, listPtr); + } + return JIM_OK; +} + + +static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?"); + return JIM_ERR; + } + Jim_SetResult(interp, argv[1]); + if (argc == 3) { + JimSetStackTrace(interp, argv[2]); + return JIM_ERR; + } + interp->addStackTrace++; + return JIM_ERR; +} + + +static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + + if (argc != 4) { + Jim_WrongNumArgs(interp, 1, argv, "list first last"); + return JIM_ERR; + } + if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL) + return JIM_ERR; + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + + +static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + long count; + + if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) { + Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?"); + return JIM_ERR; + } + + if (count == 0 || argc == 2) { + return JIM_OK; + } + + argc -= 2; + argv += 2; + + objPtr = Jim_NewListObj(interp, argv, argc); + while (--count) { + ListInsertElements(objPtr, -1, argc, argv); + } + + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + +char **Jim_GetEnviron(void) +{ +#if defined(HAVE__NSGETENVIRON) + return *_NSGetEnviron(); +#else + #if !defined(NO_ENVIRON_EXTERN) + extern char **environ; + #endif + + return environ; +#endif +} + +void Jim_SetEnviron(char **env) +{ +#if defined(HAVE__NSGETENVIRON) + *_NSGetEnviron() = env; +#else + #if !defined(NO_ENVIRON_EXTERN) + extern char **environ; + #endif + + environ = env; +#endif +} + + +static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *key; + const char *val; + + if (argc == 1) { + char **e = Jim_GetEnviron(); + + int i; + Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0); + + for (i = 0; e[i]; i++) { + const char *equals = strchr(e[i], '='); + + if (equals) { + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i], + equals - e[i])); + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1)); + } + } + + Jim_SetResult(interp, listObjPtr); + return JIM_OK; + } + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?default?"); + return JIM_ERR; + } + key = Jim_String(argv[1]); + val = getenv(key); + if (val == NULL) { + if (argc < 3) { + Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]); + return JIM_ERR; + } + val = Jim_String(argv[2]); + } + Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1)); + return JIM_OK; +} + + +static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retval; + + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "fileName"); + return JIM_ERR; + } + retval = Jim_EvalFile(interp, Jim_String(argv[1])); + if (retval == JIM_RETURN) + return JIM_OK; + return retval; +} + + +static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *revObjPtr, **ele; + int len; + + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "list"); + return JIM_ERR; + } + JimListGetElements(interp, argv[1], &len, &ele); + len--; + revObjPtr = Jim_NewListObj(interp, NULL, 0); + while (len >= 0) + ListAppendElement(revObjPtr, ele[len--]); + Jim_SetResult(interp, revObjPtr); + return JIM_OK; +} + +static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step) +{ + jim_wide len; + + if (step == 0) + return -1; + if (start == end) + return 0; + else if (step > 0 && start > end) + return -1; + else if (step < 0 && end > start) + return -1; + len = end - start; + if (len < 0) + len = -len; + if (step < 0) + step = -step; + len = 1 + ((len - 1) / step); + if (len > INT_MAX) + len = INT_MAX; + return (int)((len < 0) ? -1 : len); +} + + +static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + jim_wide start = 0, end, step = 1; + int len, i; + Jim_Obj *objPtr; + + if (argc < 2 || argc > 4) { + Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?"); + return JIM_ERR; + } + if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &end) != JIM_OK) + return JIM_ERR; + } + else { + if (Jim_GetWide(interp, argv[1], &start) != JIM_OK || + Jim_GetWide(interp, argv[2], &end) != JIM_OK) + return JIM_ERR; + if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK) + return JIM_ERR; + } + if ((len = JimRangeLen(start, end, step)) == -1) { + Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1); + return JIM_ERR; + } + objPtr = Jim_NewListObj(interp, NULL, 0); + for (i = 0; i < len; i++) + ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step)); + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + + +static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + jim_wide min = 0, max = 0, len, maxMul; + + if (argc < 1 || argc > 3) { + Jim_WrongNumArgs(interp, 1, argv, "?min? max"); + return JIM_ERR; + } + if (argc == 1) { + max = JIM_WIDE_MAX; + } else if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &max) != JIM_OK) + return JIM_ERR; + } else if (argc == 3) { + if (Jim_GetWide(interp, argv[1], &min) != JIM_OK || + Jim_GetWide(interp, argv[2], &max) != JIM_OK) + return JIM_ERR; + } + len = max-min; + if (len < 0) { + Jim_SetResultString(interp, "Invalid arguments (max < min)", -1); + return JIM_ERR; + } + maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0); + while (1) { + jim_wide r; + + JimRandomBytes(interp, &r, sizeof(jim_wide)); + if (r < 0 || r >= maxMul) continue; + r = (len == 0) ? 0 : r%len; + Jim_SetResultInt(interp, min+r); + return JIM_OK; + } +} + +static const struct { + const char *name; + Jim_CmdProc *cmdProc; +} Jim_CoreCommandsTable[] = { + {"alias", Jim_AliasCoreCommand}, + {"set", Jim_SetCoreCommand}, + {"unset", Jim_UnsetCoreCommand}, + {"puts", Jim_PutsCoreCommand}, + {"+", Jim_AddCoreCommand}, + {"*", Jim_MulCoreCommand}, + {"-", Jim_SubCoreCommand}, + {"/", Jim_DivCoreCommand}, + {"incr", Jim_IncrCoreCommand}, + {"while", Jim_WhileCoreCommand}, + {"loop", Jim_LoopCoreCommand}, + {"for", Jim_ForCoreCommand}, + {"foreach", Jim_ForeachCoreCommand}, + {"lmap", Jim_LmapCoreCommand}, + {"lassign", Jim_LassignCoreCommand}, + {"if", Jim_IfCoreCommand}, + {"switch", Jim_SwitchCoreCommand}, + {"list", Jim_ListCoreCommand}, + {"lindex", Jim_LindexCoreCommand}, + {"lset", Jim_LsetCoreCommand}, + {"lsearch", Jim_LsearchCoreCommand}, + {"llength", Jim_LlengthCoreCommand}, + {"lappend", Jim_LappendCoreCommand}, + {"linsert", Jim_LinsertCoreCommand}, + {"lreplace", Jim_LreplaceCoreCommand}, + {"lsort", Jim_LsortCoreCommand}, + {"append", Jim_AppendCoreCommand}, + {"debug", Jim_DebugCoreCommand}, + {"eval", Jim_EvalCoreCommand}, + {"uplevel", Jim_UplevelCoreCommand}, + {"expr", Jim_ExprCoreCommand}, + {"break", Jim_BreakCoreCommand}, + {"continue", Jim_ContinueCoreCommand}, + {"proc", Jim_ProcCoreCommand}, + {"concat", Jim_ConcatCoreCommand}, + {"return", Jim_ReturnCoreCommand}, + {"upvar", Jim_UpvarCoreCommand}, + {"global", Jim_GlobalCoreCommand}, + {"string", Jim_StringCoreCommand}, + {"time", Jim_TimeCoreCommand}, + {"exit", Jim_ExitCoreCommand}, + {"catch", Jim_CatchCoreCommand}, +#ifdef JIM_REFERENCES + {"ref", Jim_RefCoreCommand}, + {"getref", Jim_GetrefCoreCommand}, + {"setref", Jim_SetrefCoreCommand}, + {"finalize", Jim_FinalizeCoreCommand}, + {"collect", Jim_CollectCoreCommand}, +#endif + {"rename", Jim_RenameCoreCommand}, + {"dict", Jim_DictCoreCommand}, + {"subst", Jim_SubstCoreCommand}, + {"info", Jim_InfoCoreCommand}, + {"exists", Jim_ExistsCoreCommand}, + {"split", Jim_SplitCoreCommand}, + {"join", Jim_JoinCoreCommand}, + {"format", Jim_FormatCoreCommand}, + {"scan", Jim_ScanCoreCommand}, + {"error", Jim_ErrorCoreCommand}, + {"lrange", Jim_LrangeCoreCommand}, + {"lrepeat", Jim_LrepeatCoreCommand}, + {"env", Jim_EnvCoreCommand}, + {"source", Jim_SourceCoreCommand}, + {"lreverse", Jim_LreverseCoreCommand}, + {"range", Jim_RangeCoreCommand}, + {"rand", Jim_RandCoreCommand}, + {"tailcall", Jim_TailcallCoreCommand}, + {"local", Jim_LocalCoreCommand}, + {"upcall", Jim_UpcallCoreCommand}, + {"apply", Jim_ApplyCoreCommand}, + {NULL, NULL}, +}; + +void Jim_RegisterCoreCommands(Jim_Interp *interp) +{ + int i = 0; + + while (Jim_CoreCommandsTable[i].name != NULL) { + Jim_CreateCommand(interp, + Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL); + i++; + } +} + +void Jim_MakeErrorMessage(Jim_Interp *interp) +{ + Jim_Obj *argv[2]; + + argv[0] = Jim_NewStringObj(interp, "errorInfo", -1); + argv[1] = interp->result; + + Jim_EvalObjVector(interp, 2, argv); +} + +static char **JimSortStringTable(const char *const *tablePtr) +{ + int count; + char **tablePtrSorted; + + + for (count = 0; tablePtr[count]; count++) { + } + + + tablePtrSorted = Jim_Alloc(sizeof(char *) * (count + 1)); + memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count); + qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers); + tablePtrSorted[count] = NULL; + + return tablePtrSorted; +} + +static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype, + const char *prefix, const char *const *tablePtr, const char *name) +{ + char **tablePtrSorted; + int i; + + if (name == NULL) { + name = "option"; + } + + Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg); + tablePtrSorted = JimSortStringTable(tablePtr); + for (i = 0; tablePtrSorted[i]; i++) { + if (tablePtrSorted[i + 1] == NULL && i > 0) { + Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1); + } + Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL); + if (tablePtrSorted[i + 1]) { + Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1); + } + } + Jim_Free(tablePtrSorted); +} + + +int Jim_CheckShowCommands(Jim_Interp *interp, Jim_Obj *objPtr, const char *const *tablePtr) +{ + if (Jim_CompareStringImmediate(interp, objPtr, "-commands")) { + int i; + char **tablePtrSorted = JimSortStringTable(tablePtr); + Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0)); + for (i = 0; tablePtrSorted[i]; i++) { + Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp, tablePtrSorted[i], -1)); + } + Jim_Free(tablePtrSorted); + return JIM_OK; + } + return JIM_ERR; +} + +static const Jim_ObjType getEnumObjType = { + "get-enum", + NULL, + NULL, + NULL, + JIM_TYPE_REFERENCES +}; + +int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr, + const char *const *tablePtr, int *indexPtr, const char *name, int flags) +{ + const char *bad = "bad "; + const char *const *entryPtr = NULL; + int i; + int match = -1; + int arglen; + const char *arg; + + if (objPtr->typePtr == &getEnumObjType) { + if (objPtr->internalRep.ptrIntValue.ptr == tablePtr && objPtr->internalRep.ptrIntValue.int1 == flags) { + *indexPtr = objPtr->internalRep.ptrIntValue.int2; + return JIM_OK; + } + } + + arg = Jim_GetString(objPtr, &arglen); + + *indexPtr = -1; + + for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) { + if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) { + + match = i; + goto found; + } + if (flags & JIM_ENUM_ABBREV) { + if (strncmp(arg, *entryPtr, arglen) == 0) { + if (*arg == '-' && arglen == 1) { + break; + } + if (match >= 0) { + bad = "ambiguous "; + goto ambiguous; + } + match = i; + } + } + } + + + if (match >= 0) { + found: + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &getEnumObjType; + objPtr->internalRep.ptrIntValue.ptr = (void *)tablePtr; + objPtr->internalRep.ptrIntValue.int1 = flags; + objPtr->internalRep.ptrIntValue.int2 = match; + + *indexPtr = match; + return JIM_OK; + } + + ambiguous: + if (flags & JIM_ERRMSG) { + JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name); + } + return JIM_ERR; +} + +int Jim_FindByName(const char *name, const char * const array[], size_t len) +{ + int i; + + for (i = 0; i < (int)len; i++) { + if (array[i] && strcmp(array[i], name) == 0) { + return i; + } + } + return -1; +} + +int Jim_IsDict(Jim_Obj *objPtr) +{ + return objPtr->typePtr == &dictObjType; +} + +int Jim_IsList(Jim_Obj *objPtr) +{ + return objPtr->typePtr == &listObjType; +} + +void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...) +{ + + int len = strlen(format); + int extra = 0; + int n = 0; + const char *params[5]; + int nobjparam = 0; + Jim_Obj *objparam[5]; + char *buf; + va_list args; + int i; + + va_start(args, format); + + for (i = 0; i < len && n < 5; i++) { + int l; + + if (strncmp(format + i, "%s", 2) == 0) { + params[n] = va_arg(args, char *); + + l = strlen(params[n]); + } + else if (strncmp(format + i, "%#s", 3) == 0) { + Jim_Obj *objPtr = va_arg(args, Jim_Obj *); + + params[n] = Jim_GetString(objPtr, &l); + objparam[nobjparam++] = objPtr; + Jim_IncrRefCount(objPtr); + } + else { + if (format[i] == '%') { + i++; + } + continue; + } + n++; + extra += l; + } + + len += extra; + buf = Jim_Alloc(len + 1); + len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]); + + va_end(args); + + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len)); + + for (i = 0; i < nobjparam; i++) { + Jim_DecrRefCount(interp, objparam[i]); + } +} + + +#ifndef jim_ext_package +int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags) +{ + return JIM_OK; +} +#endif +#ifndef jim_ext_aio +FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj) +{ + Jim_SetResultString(interp, "aio not enabled", -1); + return NULL; +} +#endif + + +#include +#include + + +static int subcmd_null(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + + return JIM_OK; +} + +static const jim_subcmd_type dummy_subcmd = { + "dummy", NULL, subcmd_null, 0, 0, JIM_MODFLAG_HIDDEN +}; + +static void add_commands(Jim_Interp *interp, const jim_subcmd_type * ct, const char *sep) +{ + const char *s = ""; + + for (; ct->cmd; ct++) { + if (!(ct->flags & JIM_MODFLAG_HIDDEN)) { + Jim_AppendStrings(interp, Jim_GetResult(interp), s, ct->cmd, NULL); + s = sep; + } + } +} + +static void bad_subcmd(Jim_Interp *interp, const jim_subcmd_type * command_table, const char *type, + Jim_Obj *cmd, Jim_Obj *subcmd) +{ + Jim_SetResultFormatted(interp, "%#s, %s command \"%#s\": should be ", cmd, type, subcmd); + add_commands(interp, command_table, ", "); +} + +static void show_cmd_usage(Jim_Interp *interp, const jim_subcmd_type * command_table, int argc, + Jim_Obj *const *argv) +{ + Jim_SetResultFormatted(interp, "Usage: \"%#s command ... \", where command is one of: ", argv[0]); + add_commands(interp, command_table, ", "); +} + +static void add_cmd_usage(Jim_Interp *interp, const jim_subcmd_type * ct, Jim_Obj *cmd) +{ + if (cmd) { + Jim_AppendStrings(interp, Jim_GetResult(interp), Jim_String(cmd), " ", NULL); + } + Jim_AppendStrings(interp, Jim_GetResult(interp), ct->cmd, NULL); + if (ct->args && *ct->args) { + Jim_AppendStrings(interp, Jim_GetResult(interp), " ", ct->args, NULL); + } +} + +static void set_wrong_args(Jim_Interp *interp, const jim_subcmd_type * command_table, Jim_Obj *subcmd) +{ + Jim_SetResultString(interp, "wrong # args: should be \"", -1); + add_cmd_usage(interp, command_table, subcmd); + Jim_AppendStrings(interp, Jim_GetResult(interp), "\"", NULL); +} + +static const Jim_ObjType subcmdLookupObjType = { + "subcmd-lookup", + NULL, + NULL, + NULL, + JIM_TYPE_REFERENCES +}; + +const jim_subcmd_type *Jim_ParseSubCmd(Jim_Interp *interp, const jim_subcmd_type * command_table, + int argc, Jim_Obj *const *argv) +{ + const jim_subcmd_type *ct; + const jim_subcmd_type *partial = 0; + int cmdlen; + Jim_Obj *cmd; + const char *cmdstr; + int help = 0; + + if (argc < 2) { + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s command ...\"\n" + "Use \"%#s -help ?command?\" for help", argv[0], argv[0]); + return 0; + } + + cmd = argv[1]; + + + if (cmd->typePtr == &subcmdLookupObjType) { + if (cmd->internalRep.ptrIntValue.ptr == command_table) { + ct = command_table + cmd->internalRep.ptrIntValue.int1; + goto found; + } + } + + + if (Jim_CompareStringImmediate(interp, cmd, "-help")) { + if (argc == 2) { + + show_cmd_usage(interp, command_table, argc, argv); + return &dummy_subcmd; + } + help = 1; + + + cmd = argv[2]; + } + + + if (Jim_CompareStringImmediate(interp, cmd, "-commands")) { + + Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); + add_commands(interp, command_table, " "); + return &dummy_subcmd; + } + + cmdstr = Jim_GetString(cmd, &cmdlen); + + for (ct = command_table; ct->cmd; ct++) { + if (Jim_CompareStringImmediate(interp, cmd, ct->cmd)) { + + break; + } + if (strncmp(cmdstr, ct->cmd, cmdlen) == 0) { + if (partial) { + + if (help) { + + show_cmd_usage(interp, command_table, argc, argv); + return &dummy_subcmd; + } + bad_subcmd(interp, command_table, "ambiguous", argv[0], argv[1 + help]); + return 0; + } + partial = ct; + } + continue; + } + + + if (partial && !ct->cmd) { + ct = partial; + } + + if (!ct->cmd) { + + if (help) { + + show_cmd_usage(interp, command_table, argc, argv); + return &dummy_subcmd; + } + bad_subcmd(interp, command_table, "unknown", argv[0], argv[1 + help]); + return 0; + } + + if (help) { + Jim_SetResultString(interp, "Usage: ", -1); + + add_cmd_usage(interp, ct, argv[0]); + return &dummy_subcmd; + } + + + Jim_FreeIntRep(interp, cmd); + cmd->typePtr = &subcmdLookupObjType; + cmd->internalRep.ptrIntValue.ptr = (void *)command_table; + cmd->internalRep.ptrIntValue.int1 = ct - command_table; + +found: + + if (argc - 2 < ct->minargs || (ct->maxargs >= 0 && argc - 2 > ct->maxargs)) { + Jim_SetResultString(interp, "wrong # args: should be \"", -1); + + add_cmd_usage(interp, ct, argv[0]); + Jim_AppendStrings(interp, Jim_GetResult(interp), "\"", NULL); + + return 0; + } + + + return ct; +} + +int Jim_CallSubCmd(Jim_Interp *interp, const jim_subcmd_type * ct, int argc, Jim_Obj *const *argv) +{ + int ret = JIM_ERR; + + if (ct) { + if (ct->flags & JIM_MODFLAG_FULLARGV) { + ret = ct->function(interp, argc, argv); + } + else { + ret = ct->function(interp, argc - 2, argv + 2); + } + if (ret < 0) { + set_wrong_args(interp, ct, argv[0]); + ret = JIM_ERR; + } + } + return ret; +} + +int Jim_SubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const jim_subcmd_type *ct = + Jim_ParseSubCmd(interp, (const jim_subcmd_type *)Jim_CmdPrivData(interp), argc, argv); + + return Jim_CallSubCmd(interp, ct, argc, argv); +} + +#include +#include +#include +#include +#include + + +int utf8_fromunicode(char *p, unsigned uc) +{ + if (uc <= 0x7f) { + *p = uc; + return 1; + } + else if (uc <= 0x7ff) { + *p++ = 0xc0 | ((uc & 0x7c0) >> 6); + *p = 0x80 | (uc & 0x3f); + return 2; + } + else if (uc <= 0xffff) { + *p++ = 0xe0 | ((uc & 0xf000) >> 12); + *p++ = 0x80 | ((uc & 0xfc0) >> 6); + *p = 0x80 | (uc & 0x3f); + return 3; + } + + else { + *p++ = 0xf0 | ((uc & 0x1c0000) >> 18); + *p++ = 0x80 | ((uc & 0x3f000) >> 12); + *p++ = 0x80 | ((uc & 0xfc0) >> 6); + *p = 0x80 | (uc & 0x3f); + return 4; + } +} + +#include +#include + + +#define JIM_INTEGER_SPACE 24 +#define MAX_FLOAT_WIDTH 320 + +Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr, int objc, Jim_Obj *const *objv) +{ + const char *span, *format, *formatEnd, *msg; + int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; + static const char * const mixedXPG = + "cannot mix \"%\" and \"%n$\" conversion specifiers"; + static const char * const badIndex[2] = { + "not enough arguments for all format specifiers", + "\"%n$\" argument index out of range" + }; + int formatLen; + Jim_Obj *resultPtr; + + char *num_buffer = NULL; + int num_buffer_size = 0; + + span = format = Jim_GetString(fmtObjPtr, &formatLen); + formatEnd = format + formatLen; + resultPtr = Jim_NewEmptyStringObj(interp); + + while (format != formatEnd) { + char *end; + int gotMinus, sawFlag; + int gotPrecision, useShort; + long width, precision; + int newXpg; + int ch; + int step; + int doubleType; + char pad = ' '; + char spec[2*JIM_INTEGER_SPACE + 12]; + char *p; + + int formatted_chars; + int formatted_bytes; + const char *formatted_buf; + + step = utf8_tounicode(format, &ch); + format += step; + if (ch != '%') { + numBytes += step; + continue; + } + if (numBytes) { + Jim_AppendString(interp, resultPtr, span, numBytes); + numBytes = 0; + } + + + step = utf8_tounicode(format, &ch); + if (ch == '%') { + span = format; + numBytes = step; + format += step; + continue; + } + + + newXpg = 0; + if (isdigit(ch)) { + int position = strtoul(format, &end, 10); + if (*end == '$') { + newXpg = 1; + objIndex = position - 1; + format = end + 1; + step = utf8_tounicode(format, &ch); + } + } + if (newXpg) { + if (gotSequential) { + msg = mixedXPG; + goto errorMsg; + } + gotXpg = 1; + } else { + if (gotXpg) { + msg = mixedXPG; + goto errorMsg; + } + gotSequential = 1; + } + if ((objIndex < 0) || (objIndex >= objc)) { + msg = badIndex[gotXpg]; + goto errorMsg; + } + + p = spec; + *p++ = '%'; + + gotMinus = 0; + sawFlag = 1; + do { + switch (ch) { + case '-': + gotMinus = 1; + break; + case '0': + pad = ch; + break; + case ' ': + case '+': + case '#': + break; + default: + sawFlag = 0; + continue; + } + *p++ = ch; + format += step; + step = utf8_tounicode(format, &ch); + + } while (sawFlag && (p - spec <= 5)); + + + width = 0; + if (isdigit(ch)) { + width = strtoul(format, &end, 10); + format = end; + step = utf8_tounicode(format, &ch); + } else if (ch == '*') { + if (objIndex >= objc - 1) { + msg = badIndex[gotXpg]; + goto errorMsg; + } + if (Jim_GetLong(interp, objv[objIndex], &width) != JIM_OK) { + goto error; + } + if (width < 0) { + width = -width; + if (!gotMinus) { + *p++ = '-'; + gotMinus = 1; + } + } + objIndex++; + format += step; + step = utf8_tounicode(format, &ch); + } + + + gotPrecision = precision = 0; + if (ch == '.') { + gotPrecision = 1; + format += step; + step = utf8_tounicode(format, &ch); + } + if (isdigit(ch)) { + precision = strtoul(format, &end, 10); + format = end; + step = utf8_tounicode(format, &ch); + } else if (ch == '*') { + if (objIndex >= objc - 1) { + msg = badIndex[gotXpg]; + goto errorMsg; + } + if (Jim_GetLong(interp, objv[objIndex], &precision) != JIM_OK) { + goto error; + } + + + if (precision < 0) { + precision = 0; + } + objIndex++; + format += step; + step = utf8_tounicode(format, &ch); + } + + + useShort = 0; + if (ch == 'h') { + useShort = 1; + format += step; + step = utf8_tounicode(format, &ch); + } else if (ch == 'l') { + + format += step; + step = utf8_tounicode(format, &ch); + if (ch == 'l') { + format += step; + step = utf8_tounicode(format, &ch); + } + } + + format += step; + span = format; + + + if (ch == 'i') { + ch = 'd'; + } + + doubleType = 0; + + switch (ch) { + case '\0': + msg = "format string ended in middle of field specifier"; + goto errorMsg; + case 's': { + formatted_buf = Jim_GetString(objv[objIndex], &formatted_bytes); + formatted_chars = Jim_Utf8Length(interp, objv[objIndex]); + if (gotPrecision && (precision < formatted_chars)) { + + formatted_chars = precision; + formatted_bytes = utf8_index(formatted_buf, precision); + } + break; + } + case 'c': { + jim_wide code; + + if (Jim_GetWide(interp, objv[objIndex], &code) != JIM_OK) { + goto error; + } + + formatted_bytes = utf8_getchars(spec, code); + formatted_buf = spec; + formatted_chars = 1; + break; + } + case 'b': { + unsigned jim_wide w; + int length; + int i; + int j; + + if (Jim_GetWide(interp, objv[objIndex], (jim_wide *)&w) != JIM_OK) { + goto error; + } + length = sizeof(w) * 8; + + + + if (num_buffer_size < length + 1) { + num_buffer_size = length + 1; + num_buffer = Jim_Realloc(num_buffer, num_buffer_size); + } + + j = 0; + for (i = length; i > 0; ) { + i--; + if (w & ((unsigned jim_wide)1 << i)) { + num_buffer[j++] = '1'; + } + else if (j || i == 0) { + num_buffer[j++] = '0'; + } + } + num_buffer[j] = 0; + formatted_chars = formatted_bytes = j; + formatted_buf = num_buffer; + break; + } + + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': + doubleType = 1; + + case 'd': + case 'u': + case 'o': + case 'x': + case 'X': { + jim_wide w; + double d; + int length; + + + if (width) { + p += sprintf(p, "%ld", width); + } + if (gotPrecision) { + p += sprintf(p, ".%ld", precision); + } + + + if (doubleType) { + if (Jim_GetDouble(interp, objv[objIndex], &d) != JIM_OK) { + goto error; + } + length = MAX_FLOAT_WIDTH; + } + else { + if (Jim_GetWide(interp, objv[objIndex], &w) != JIM_OK) { + goto error; + } + length = JIM_INTEGER_SPACE; + if (useShort) { + if (ch == 'd') { + w = (short)w; + } + else { + w = (unsigned short)w; + } + } + *p++ = 'l'; +#ifdef HAVE_LONG_LONG + if (sizeof(long long) == sizeof(jim_wide)) { + *p++ = 'l'; + } +#endif + } + + *p++ = (char) ch; + *p = '\0'; + + + if (width > 10000 || length > 10000 || precision > 10000) { + Jim_SetResultString(interp, "format too long", -1); + goto error; + } + + + + if (width > length) { + length = width; + } + if (gotPrecision) { + length += precision; + } + + + if (num_buffer_size < length + 1) { + num_buffer_size = length + 1; + num_buffer = Jim_Realloc(num_buffer, num_buffer_size); + } + + if (doubleType) { + snprintf(num_buffer, length + 1, spec, d); + } + else { + formatted_bytes = snprintf(num_buffer, length + 1, spec, w); + } + formatted_chars = formatted_bytes = strlen(num_buffer); + formatted_buf = num_buffer; + break; + } + + default: { + + spec[0] = ch; + spec[1] = '\0'; + Jim_SetResultFormatted(interp, "bad field specifier \"%s\"", spec); + goto error; + } + } + + if (!gotMinus) { + while (formatted_chars < width) { + Jim_AppendString(interp, resultPtr, &pad, 1); + formatted_chars++; + } + } + + Jim_AppendString(interp, resultPtr, formatted_buf, formatted_bytes); + + while (formatted_chars < width) { + Jim_AppendString(interp, resultPtr, &pad, 1); + formatted_chars++; + } + + objIndex += gotSequential; + } + if (numBytes) { + Jim_AppendString(interp, resultPtr, span, numBytes); + } + + Jim_Free(num_buffer); + return resultPtr; + + errorMsg: + Jim_SetResultString(interp, msg, -1); + error: + Jim_FreeNewObj(interp, resultPtr); + Jim_Free(num_buffer); + return NULL; +} + + +#if defined(JIM_REGEXP) +#include +#include +#include +#include + + + +#define REG_MAX_PAREN 100 + + + +#define END 0 +#define BOL 1 +#define EOL 2 +#define ANY 3 +#define ANYOF 4 +#define ANYBUT 5 +#define BRANCH 6 +#define BACK 7 +#define EXACTLY 8 +#define NOTHING 9 +#define REP 10 +#define REPMIN 11 +#define REPX 12 +#define REPXMIN 13 +#define BOLX 14 +#define EOLX 15 +#define WORDA 16 +#define WORDZ 17 + +#define OPENNC 1000 +#define OPEN 1001 + + + + +#define CLOSENC 2000 +#define CLOSE 2001 +#define CLOSE_END (CLOSE+REG_MAX_PAREN) + +#define REG_MAGIC 0xFADED00D + + +#define OP(preg, p) (preg->program[p]) +#define NEXT(preg, p) (preg->program[p + 1]) +#define OPERAND(p) ((p) + 2) + + + + +#define FAIL(R,M) { (R)->err = (M); return (M); } +#define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?' || (c) == '{') +#define META "^$.[()|?{+*" + +#define HASWIDTH 1 +#define SIMPLE 2 +#define SPSTART 4 +#define WORST 0 + +#define MAX_REP_COUNT 1000000 + +static int reg(regex_t *preg, int paren, int *flagp ); +static int regpiece(regex_t *preg, int *flagp ); +static int regbranch(regex_t *preg, int *flagp ); +static int regatom(regex_t *preg, int *flagp ); +static int regnode(regex_t *preg, int op ); +static int regnext(regex_t *preg, int p ); +static void regc(regex_t *preg, int b ); +static int reginsert(regex_t *preg, int op, int size, int opnd ); +static void regtail(regex_t *preg, int p, int val); +static void regoptail(regex_t *preg, int p, int val ); +static int regopsize(regex_t *preg, int p ); + +static int reg_range_find(const int *string, int c); +static const char *str_find(const char *string, int c, int nocase); +static int prefix_cmp(const int *prog, int proglen, const char *string, int nocase); + + +#ifdef DEBUG +static int regnarrate = 0; +static void regdump(regex_t *preg); +static const char *regprop( int op ); +#endif + + +static int str_int_len(const int *seq) +{ + int n = 0; + while (*seq++) { + n++; + } + return n; +} + +int regcomp(regex_t *preg, const char *exp, int cflags) +{ + int scan; + int longest; + unsigned len; + int flags; + +#ifdef DEBUG + fprintf(stderr, "Compiling: '%s'\n", exp); +#endif + memset(preg, 0, sizeof(*preg)); + + if (exp == NULL) + FAIL(preg, REG_ERR_NULL_ARGUMENT); + + + preg->cflags = cflags; + preg->regparse = exp; + + + preg->proglen = (strlen(exp) + 1) * 5; + preg->program = malloc(preg->proglen * sizeof(int)); + if (preg->program == NULL) + FAIL(preg, REG_ERR_NOMEM); + + regc(preg, REG_MAGIC); + if (reg(preg, 0, &flags) == 0) { + return preg->err; + } + + + if (preg->re_nsub >= REG_MAX_PAREN) + FAIL(preg,REG_ERR_TOO_BIG); + + + preg->regstart = 0; + preg->reganch = 0; + preg->regmust = 0; + preg->regmlen = 0; + scan = 1; + if (OP(preg, regnext(preg, scan)) == END) { + scan = OPERAND(scan); + + + if (OP(preg, scan) == EXACTLY) { + preg->regstart = preg->program[OPERAND(scan)]; + } + else if (OP(preg, scan) == BOL) + preg->reganch++; + + if (flags&SPSTART) { + longest = 0; + len = 0; + for (; scan != 0; scan = regnext(preg, scan)) { + if (OP(preg, scan) == EXACTLY) { + int plen = str_int_len(preg->program + OPERAND(scan)); + if (plen >= len) { + longest = OPERAND(scan); + len = plen; + } + } + } + preg->regmust = longest; + preg->regmlen = len; + } + } + +#ifdef DEBUG + regdump(preg); +#endif + + return 0; +} + +static int reg(regex_t *preg, int paren, int *flagp ) +{ + int ret; + int br; + int ender; + int parno = 0; + int flags; + + *flagp = HASWIDTH; + + + if (paren) { + if (preg->regparse[0] == '?' && preg->regparse[1] == ':') { + + preg->regparse += 2; + parno = -1; + } + else { + parno = ++preg->re_nsub; + } + ret = regnode(preg, OPEN+parno); + } else + ret = 0; + + + br = regbranch(preg, &flags); + if (br == 0) + return 0; + if (ret != 0) + regtail(preg, ret, br); + else + ret = br; + if (!(flags&HASWIDTH)) + *flagp &= ~HASWIDTH; + *flagp |= flags&SPSTART; + while (*preg->regparse == '|') { + preg->regparse++; + br = regbranch(preg, &flags); + if (br == 0) + return 0; + regtail(preg, ret, br); + if (!(flags&HASWIDTH)) + *flagp &= ~HASWIDTH; + *flagp |= flags&SPSTART; + } + + + ender = regnode(preg, (paren) ? CLOSE+parno : END); + regtail(preg, ret, ender); + + + for (br = ret; br != 0; br = regnext(preg, br)) + regoptail(preg, br, ender); + + + if (paren && *preg->regparse++ != ')') { + preg->err = REG_ERR_UNMATCHED_PAREN; + return 0; + } else if (!paren && *preg->regparse != '\0') { + if (*preg->regparse == ')') { + preg->err = REG_ERR_UNMATCHED_PAREN; + return 0; + } else { + preg->err = REG_ERR_JUNK_ON_END; + return 0; + } + } + + return(ret); +} + +static int regbranch(regex_t *preg, int *flagp ) +{ + int ret; + int chain; + int latest; + int flags; + + *flagp = WORST; + + ret = regnode(preg, BRANCH); + chain = 0; + while (*preg->regparse != '\0' && *preg->regparse != ')' && + *preg->regparse != '|') { + latest = regpiece(preg, &flags); + if (latest == 0) + return 0; + *flagp |= flags&HASWIDTH; + if (chain == 0) { + *flagp |= flags&SPSTART; + } + else { + regtail(preg, chain, latest); + } + chain = latest; + } + if (chain == 0) + (void) regnode(preg, NOTHING); + + return(ret); +} + +static int regpiece(regex_t *preg, int *flagp) +{ + int ret; + char op; + int next; + int flags; + int min; + int max; + + ret = regatom(preg, &flags); + if (ret == 0) + return 0; + + op = *preg->regparse; + if (!ISMULT(op)) { + *flagp = flags; + return(ret); + } + + if (!(flags&HASWIDTH) && op != '?') { + preg->err = REG_ERR_OPERAND_COULD_BE_EMPTY; + return 0; + } + + + if (op == '{') { + char *end; + + min = strtoul(preg->regparse + 1, &end, 10); + if (end == preg->regparse + 1) { + preg->err = REG_ERR_BAD_COUNT; + return 0; + } + if (*end == '}') { + max = min; + } + else if (*end == '\0') { + preg->err = REG_ERR_UNMATCHED_BRACES; + return 0; + } + else { + preg->regparse = end; + max = strtoul(preg->regparse + 1, &end, 10); + if (*end != '}') { + preg->err = REG_ERR_UNMATCHED_BRACES; + return 0; + } + } + if (end == preg->regparse + 1) { + max = MAX_REP_COUNT; + } + else if (max < min || max >= 100) { + preg->err = REG_ERR_BAD_COUNT; + return 0; + } + if (min >= 100) { + preg->err = REG_ERR_BAD_COUNT; + return 0; + } + + preg->regparse = strchr(preg->regparse, '}'); + } + else { + min = (op == '+'); + max = (op == '?' ? 1 : MAX_REP_COUNT); + } + + if (preg->regparse[1] == '?') { + preg->regparse++; + next = reginsert(preg, flags & SIMPLE ? REPMIN : REPXMIN, 5, ret); + } + else { + next = reginsert(preg, flags & SIMPLE ? REP: REPX, 5, ret); + } + preg->program[ret + 2] = max; + preg->program[ret + 3] = min; + preg->program[ret + 4] = 0; + + *flagp = (min) ? (WORST|HASWIDTH) : (WORST|SPSTART); + + if (!(flags & SIMPLE)) { + int back = regnode(preg, BACK); + regtail(preg, back, ret); + regtail(preg, next, back); + } + + preg->regparse++; + if (ISMULT(*preg->regparse)) { + preg->err = REG_ERR_NESTED_COUNT; + return 0; + } + + return ret; +} + +static void reg_addrange(regex_t *preg, int lower, int upper) +{ + if (lower > upper) { + reg_addrange(preg, upper, lower); + } + + regc(preg, upper - lower + 1); + regc(preg, lower); +} + +static void reg_addrange_str(regex_t *preg, const char *str) +{ + while (*str) { + reg_addrange(preg, *str, *str); + str++; + } +} + +static int reg_utf8_tounicode_case(const char *s, int *uc, int upper) +{ + int l = utf8_tounicode(s, uc); + if (upper) { + *uc = utf8_upper(*uc); + } + return l; +} + +static int hexdigitval(int c) +{ + if (c >= '0' && c <= '9') + return c - '0'; + if (c >= 'a' && c <= 'f') + return c - 'a' + 10; + if (c >= 'A' && c <= 'F') + return c - 'A' + 10; + return -1; +} + +static int parse_hex(const char *s, int n, int *uc) +{ + int val = 0; + int k; + + for (k = 0; k < n; k++) { + int c = hexdigitval(*s++); + if (c == -1) { + break; + } + val = (val << 4) | c; + } + if (k) { + *uc = val; + } + return k; +} + +static int reg_decode_escape(const char *s, int *ch) +{ + int n; + const char *s0 = s; + + *ch = *s++; + + switch (*ch) { + case 'b': *ch = '\b'; break; + case 'e': *ch = 27; break; + case 'f': *ch = '\f'; break; + case 'n': *ch = '\n'; break; + case 'r': *ch = '\r'; break; + case 't': *ch = '\t'; break; + case 'v': *ch = '\v'; break; + case 'u': + if (*s == '{') { + + n = parse_hex(s + 1, 6, ch); + if (n > 0 && s[n + 1] == '}' && *ch >= 0 && *ch <= 0x1fffff) { + s += n + 2; + } + else { + + *ch = 'u'; + } + } + else if ((n = parse_hex(s, 4, ch)) > 0) { + s += n; + } + break; + case 'U': + if ((n = parse_hex(s, 8, ch)) > 0) { + s += n; + } + break; + case 'x': + if ((n = parse_hex(s, 2, ch)) > 0) { + s += n; + } + break; + case '\0': + s--; + *ch = '\\'; + break; + } + return s - s0; +} + +static int regatom(regex_t *preg, int *flagp) +{ + int ret; + int flags; + int nocase = (preg->cflags & REG_ICASE); + + int ch; + int n = reg_utf8_tounicode_case(preg->regparse, &ch, nocase); + + *flagp = WORST; + + preg->regparse += n; + switch (ch) { + + case '^': + ret = regnode(preg, BOL); + break; + case '$': + ret = regnode(preg, EOL); + break; + case '.': + ret = regnode(preg, ANY); + *flagp |= HASWIDTH|SIMPLE; + break; + case '[': { + const char *pattern = preg->regparse; + + if (*pattern == '^') { + ret = regnode(preg, ANYBUT); + pattern++; + } else + ret = regnode(preg, ANYOF); + + + if (*pattern == ']' || *pattern == '-') { + reg_addrange(preg, *pattern, *pattern); + pattern++; + } + + while (*pattern && *pattern != ']') { + + int start; + int end; + + enum { + CC_ALPHA, CC_ALNUM, CC_SPACE, CC_BLANK, CC_UPPER, CC_LOWER, + CC_DIGIT, CC_XDIGIT, CC_CNTRL, CC_GRAPH, CC_PRINT, CC_PUNCT, + CC_NUM + }; + int cc; + + pattern += reg_utf8_tounicode_case(pattern, &start, nocase); + if (start == '\\') { + + switch (*pattern) { + case 's': + pattern++; + cc = CC_SPACE; + goto cc_switch; + case 'd': + pattern++; + cc = CC_DIGIT; + goto cc_switch; + case 'w': + pattern++; + reg_addrange(preg, '_', '_'); + cc = CC_ALNUM; + goto cc_switch; + } + pattern += reg_decode_escape(pattern, &start); + if (start == 0) { + preg->err = REG_ERR_NULL_CHAR; + return 0; + } + } + if (pattern[0] == '-' && pattern[1] && pattern[1] != ']') { + + pattern += utf8_tounicode(pattern, &end); + pattern += reg_utf8_tounicode_case(pattern, &end, nocase); + if (end == '\\') { + pattern += reg_decode_escape(pattern, &end); + if (end == 0) { + preg->err = REG_ERR_NULL_CHAR; + return 0; + } + } + + reg_addrange(preg, start, end); + continue; + } + if (start == '[' && pattern[0] == ':') { + static const char *character_class[] = { + ":alpha:", ":alnum:", ":space:", ":blank:", ":upper:", ":lower:", + ":digit:", ":xdigit:", ":cntrl:", ":graph:", ":print:", ":punct:", + }; + + for (cc = 0; cc < CC_NUM; cc++) { + n = strlen(character_class[cc]); + if (strncmp(pattern, character_class[cc], n) == 0) { + + pattern += n + 1; + break; + } + } + if (cc != CC_NUM) { +cc_switch: + switch (cc) { + case CC_ALNUM: + reg_addrange(preg, '0', '9'); + + case CC_ALPHA: + if ((preg->cflags & REG_ICASE) == 0) { + reg_addrange(preg, 'a', 'z'); + } + reg_addrange(preg, 'A', 'Z'); + break; + case CC_SPACE: + reg_addrange_str(preg, " \t\r\n\f\v"); + break; + case CC_BLANK: + reg_addrange_str(preg, " \t"); + break; + case CC_UPPER: + reg_addrange(preg, 'A', 'Z'); + break; + case CC_LOWER: + reg_addrange(preg, 'a', 'z'); + break; + case CC_XDIGIT: + reg_addrange(preg, 'a', 'f'); + reg_addrange(preg, 'A', 'F'); + + case CC_DIGIT: + reg_addrange(preg, '0', '9'); + break; + case CC_CNTRL: + reg_addrange(preg, 0, 31); + reg_addrange(preg, 127, 127); + break; + case CC_PRINT: + reg_addrange(preg, ' ', '~'); + break; + case CC_GRAPH: + reg_addrange(preg, '!', '~'); + break; + case CC_PUNCT: + reg_addrange(preg, '!', '/'); + reg_addrange(preg, ':', '@'); + reg_addrange(preg, '[', '`'); + reg_addrange(preg, '{', '~'); + break; + } + continue; + } + } + + reg_addrange(preg, start, start); + } + regc(preg, '\0'); + + if (*pattern) { + pattern++; + } + preg->regparse = pattern; + + *flagp |= HASWIDTH|SIMPLE; + } + break; + case '(': + ret = reg(preg, 1, &flags); + if (ret == 0) + return 0; + *flagp |= flags&(HASWIDTH|SPSTART); + break; + case '\0': + case '|': + case ')': + preg->err = REG_ERR_INTERNAL; + return 0; + case '?': + case '+': + case '*': + case '{': + preg->err = REG_ERR_COUNT_FOLLOWS_NOTHING; + return 0; + case '\\': + ch = *preg->regparse++; + switch (ch) { + case '\0': + preg->err = REG_ERR_TRAILING_BACKSLASH; + return 0; + case 'A': + ret = regnode(preg, BOLX); + break; + case 'Z': + ret = regnode(preg, EOLX); + break; + case '<': + case 'm': + ret = regnode(preg, WORDA); + break; + case '>': + case 'M': + ret = regnode(preg, WORDZ); + break; + case 'd': + case 'D': + ret = regnode(preg, ch == 'd' ? ANYOF : ANYBUT); + reg_addrange(preg, '0', '9'); + regc(preg, '\0'); + *flagp |= HASWIDTH|SIMPLE; + break; + case 'w': + case 'W': + ret = regnode(preg, ch == 'w' ? ANYOF : ANYBUT); + if ((preg->cflags & REG_ICASE) == 0) { + reg_addrange(preg, 'a', 'z'); + } + reg_addrange(preg, 'A', 'Z'); + reg_addrange(preg, '0', '9'); + reg_addrange(preg, '_', '_'); + regc(preg, '\0'); + *flagp |= HASWIDTH|SIMPLE; + break; + case 's': + case 'S': + ret = regnode(preg, ch == 's' ? ANYOF : ANYBUT); + reg_addrange_str(preg," \t\r\n\f\v"); + regc(preg, '\0'); + *flagp |= HASWIDTH|SIMPLE; + break; + + default: + + + preg->regparse--; + goto de_fault; + } + break; + de_fault: + default: { + int added = 0; + + + preg->regparse -= n; + + ret = regnode(preg, EXACTLY); + + + + while (*preg->regparse && strchr(META, *preg->regparse) == NULL) { + n = reg_utf8_tounicode_case(preg->regparse, &ch, (preg->cflags & REG_ICASE)); + if (ch == '\\' && preg->regparse[n]) { + if (strchr("<>mMwWdDsSAZ", preg->regparse[n])) { + + break; + } + n += reg_decode_escape(preg->regparse + n, &ch); + if (ch == 0) { + preg->err = REG_ERR_NULL_CHAR; + return 0; + } + } + + + if (ISMULT(preg->regparse[n])) { + + if (added) { + + break; + } + + regc(preg, ch); + added++; + preg->regparse += n; + break; + } + + + regc(preg, ch); + added++; + preg->regparse += n; + } + regc(preg, '\0'); + + *flagp |= HASWIDTH; + if (added == 1) + *flagp |= SIMPLE; + break; + } + break; + } + + return(ret); +} + +static void reg_grow(regex_t *preg, int n) +{ + if (preg->p + n >= preg->proglen) { + preg->proglen = (preg->p + n) * 2; + preg->program = realloc(preg->program, preg->proglen * sizeof(int)); + } +} + + +static int regnode(regex_t *preg, int op) +{ + reg_grow(preg, 2); + + + preg->program[preg->p++] = op; + preg->program[preg->p++] = 0; + + + return preg->p - 2; +} + +static void regc(regex_t *preg, int b ) +{ + reg_grow(preg, 1); + preg->program[preg->p++] = b; +} + +static int reginsert(regex_t *preg, int op, int size, int opnd ) +{ + reg_grow(preg, size); + + + memmove(preg->program + opnd + size, preg->program + opnd, sizeof(int) * (preg->p - opnd)); + + memset(preg->program + opnd, 0, sizeof(int) * size); + + preg->program[opnd] = op; + + preg->p += size; + + return opnd + size; +} + +static void regtail(regex_t *preg, int p, int val) +{ + int scan; + int temp; + int offset; + + + scan = p; + for (;;) { + temp = regnext(preg, scan); + if (temp == 0) + break; + scan = temp; + } + + if (OP(preg, scan) == BACK) + offset = scan - val; + else + offset = val - scan; + + preg->program[scan + 1] = offset; +} + + +static void regoptail(regex_t *preg, int p, int val ) +{ + + if (p != 0 && OP(preg, p) == BRANCH) { + regtail(preg, OPERAND(p), val); + } +} + + +static int regtry(regex_t *preg, const char *string ); +static int regmatch(regex_t *preg, int prog); +static int regrepeat(regex_t *preg, int p, int max); + +int regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags) +{ + const char *s; + int scan; + + + if (preg == NULL || preg->program == NULL || string == NULL) { + return REG_ERR_NULL_ARGUMENT; + } + + + if (*preg->program != REG_MAGIC) { + return REG_ERR_CORRUPTED; + } + +#ifdef DEBUG + fprintf(stderr, "regexec: %s\n", string); + regdump(preg); +#endif + + preg->eflags = eflags; + preg->pmatch = pmatch; + preg->nmatch = nmatch; + preg->start = string; + + + for (scan = OPERAND(1); scan != 0; scan += regopsize(preg, scan)) { + int op = OP(preg, scan); + if (op == END) + break; + if (op == REPX || op == REPXMIN) + preg->program[scan + 4] = 0; + } + + + if (preg->regmust != 0) { + s = string; + while ((s = str_find(s, preg->program[preg->regmust], preg->cflags & REG_ICASE)) != NULL) { + if (prefix_cmp(preg->program + preg->regmust, preg->regmlen, s, preg->cflags & REG_ICASE) >= 0) { + break; + } + s++; + } + if (s == NULL) + return REG_NOMATCH; + } + + + preg->regbol = string; + + + if (preg->reganch) { + if (eflags & REG_NOTBOL) { + + goto nextline; + } + while (1) { + if (regtry(preg, string)) { + return REG_NOERROR; + } + if (*string) { +nextline: + if (preg->cflags & REG_NEWLINE) { + + string = strchr(string, '\n'); + if (string) { + preg->regbol = ++string; + continue; + } + } + } + return REG_NOMATCH; + } + } + + + s = string; + if (preg->regstart != '\0') { + + while ((s = str_find(s, preg->regstart, preg->cflags & REG_ICASE)) != NULL) { + if (regtry(preg, s)) + return REG_NOERROR; + s++; + } + } + else + + while (1) { + if (regtry(preg, s)) + return REG_NOERROR; + if (*s == '\0') { + break; + } + else { + int c; + s += utf8_tounicode(s, &c); + } + } + + + return REG_NOMATCH; +} + + +static int regtry( regex_t *preg, const char *string ) +{ + int i; + + preg->reginput = string; + + for (i = 0; i < preg->nmatch; i++) { + preg->pmatch[i].rm_so = -1; + preg->pmatch[i].rm_eo = -1; + } + if (regmatch(preg, 1)) { + preg->pmatch[0].rm_so = string - preg->start; + preg->pmatch[0].rm_eo = preg->reginput - preg->start; + return(1); + } else + return(0); +} + +static int prefix_cmp(const int *prog, int proglen, const char *string, int nocase) +{ + const char *s = string; + while (proglen && *s) { + int ch; + int n = reg_utf8_tounicode_case(s, &ch, nocase); + if (ch != *prog) { + return -1; + } + prog++; + s += n; + proglen--; + } + if (proglen == 0) { + return s - string; + } + return -1; +} + +static int reg_range_find(const int *range, int c) +{ + while (*range) { + + if (c >= range[1] && c <= (range[0] + range[1] - 1)) { + return 1; + } + range += 2; + } + return 0; +} + +static const char *str_find(const char *string, int c, int nocase) +{ + if (nocase) { + + c = utf8_upper(c); + } + while (*string) { + int ch; + int n = reg_utf8_tounicode_case(string, &ch, nocase); + if (c == ch) { + return string; + } + string += n; + } + return NULL; +} + +static int reg_iseol(regex_t *preg, int ch) +{ + if (preg->cflags & REG_NEWLINE) { + return ch == '\0' || ch == '\n'; + } + else { + return ch == '\0'; + } +} + +static int regmatchsimplerepeat(regex_t *preg, int scan, int matchmin) +{ + int nextch = '\0'; + const char *save; + int no; + int c; + + int max = preg->program[scan + 2]; + int min = preg->program[scan + 3]; + int next = regnext(preg, scan); + + if (OP(preg, next) == EXACTLY) { + nextch = preg->program[OPERAND(next)]; + } + save = preg->reginput; + no = regrepeat(preg, scan + 5, max); + if (no < min) { + return 0; + } + if (matchmin) { + + max = no; + no = min; + } + + while (1) { + if (matchmin) { + if (no > max) { + break; + } + } + else { + if (no < min) { + break; + } + } + preg->reginput = save + utf8_index(save, no); + reg_utf8_tounicode_case(preg->reginput, &c, (preg->cflags & REG_ICASE)); + + if (reg_iseol(preg, nextch) || c == nextch) { + if (regmatch(preg, next)) { + return(1); + } + } + if (matchmin) { + + no++; + } + else { + + no--; + } + } + return(0); +} + +static int regmatchrepeat(regex_t *preg, int scan, int matchmin) +{ + int *scanpt = preg->program + scan; + + int max = scanpt[2]; + int min = scanpt[3]; + + + if (scanpt[4] < min) { + + scanpt[4]++; + if (regmatch(preg, scan + 5)) { + return 1; + } + scanpt[4]--; + return 0; + } + if (scanpt[4] > max) { + return 0; + } + + if (matchmin) { + + if (regmatch(preg, regnext(preg, scan))) { + return 1; + } + + scanpt[4]++; + if (regmatch(preg, scan + 5)) { + return 1; + } + scanpt[4]--; + return 0; + } + + if (scanpt[4] < max) { + scanpt[4]++; + if (regmatch(preg, scan + 5)) { + return 1; + } + scanpt[4]--; + } + + return regmatch(preg, regnext(preg, scan)); +} + + +static int regmatch(regex_t *preg, int prog) +{ + int scan; + int next; + const char *save; + + scan = prog; + +#ifdef DEBUG + if (scan != 0 && regnarrate) + fprintf(stderr, "%s(\n", regprop(scan)); +#endif + while (scan != 0) { + int n; + int c; +#ifdef DEBUG + if (regnarrate) { + fprintf(stderr, "%3d: %s...\n", scan, regprop(OP(preg, scan))); + } +#endif + next = regnext(preg, scan); + n = reg_utf8_tounicode_case(preg->reginput, &c, (preg->cflags & REG_ICASE)); + + switch (OP(preg, scan)) { + case BOLX: + if ((preg->eflags & REG_NOTBOL)) { + return(0); + } + + case BOL: + if (preg->reginput != preg->regbol) { + return(0); + } + break; + case EOLX: + if (c != 0) { + + return 0; + } + break; + case EOL: + if (!reg_iseol(preg, c)) { + return(0); + } + break; + case WORDA: + + if ((!isalnum(UCHAR(c))) && c != '_') + return(0); + + if (preg->reginput > preg->regbol && + (isalnum(UCHAR(preg->reginput[-1])) || preg->reginput[-1] == '_')) + return(0); + break; + case WORDZ: + + if (preg->reginput > preg->regbol) { + + if (reg_iseol(preg, c) || !isalnum(UCHAR(c)) || c != '_') { + c = preg->reginput[-1]; + + if (isalnum(UCHAR(c)) || c == '_') { + break; + } + } + } + + return(0); + + case ANY: + if (reg_iseol(preg, c)) + return 0; + preg->reginput += n; + break; + case EXACTLY: { + int opnd; + int len; + int slen; + + opnd = OPERAND(scan); + len = str_int_len(preg->program + opnd); + + slen = prefix_cmp(preg->program + opnd, len, preg->reginput, preg->cflags & REG_ICASE); + if (slen < 0) { + return(0); + } + preg->reginput += slen; + } + break; + case ANYOF: + if (reg_iseol(preg, c) || reg_range_find(preg->program + OPERAND(scan), c) == 0) { + return(0); + } + preg->reginput += n; + break; + case ANYBUT: + if (reg_iseol(preg, c) || reg_range_find(preg->program + OPERAND(scan), c) != 0) { + return(0); + } + preg->reginput += n; + break; + case NOTHING: + break; + case BACK: + break; + case BRANCH: + if (OP(preg, next) != BRANCH) + next = OPERAND(scan); + else { + do { + save = preg->reginput; + if (regmatch(preg, OPERAND(scan))) { + return(1); + } + preg->reginput = save; + scan = regnext(preg, scan); + } while (scan != 0 && OP(preg, scan) == BRANCH); + return(0); + + } + break; + case REP: + case REPMIN: + return regmatchsimplerepeat(preg, scan, OP(preg, scan) == REPMIN); + + case REPX: + case REPXMIN: + return regmatchrepeat(preg, scan, OP(preg, scan) == REPXMIN); + + case END: + return 1; + + case OPENNC: + case CLOSENC: + return regmatch(preg, next); + + default: + if (OP(preg, scan) >= OPEN+1 && OP(preg, scan) < CLOSE_END) { + save = preg->reginput; + if (regmatch(preg, next)) { + if (OP(preg, scan) < CLOSE) { + int no = OP(preg, scan) - OPEN; + if (no < preg->nmatch && preg->pmatch[no].rm_so == -1) { + preg->pmatch[no].rm_so = save - preg->start; + } + } + else { + int no = OP(preg, scan) - CLOSE; + if (no < preg->nmatch && preg->pmatch[no].rm_eo == -1) { + preg->pmatch[no].rm_eo = save - preg->start; + } + } + return(1); + } + return(0); + } + return REG_ERR_INTERNAL; + } + + scan = next; + } + + return REG_ERR_INTERNAL; +} + +static int regrepeat(regex_t *preg, int p, int max) +{ + int count = 0; + const char *scan; + int opnd; + int ch; + int n; + + scan = preg->reginput; + opnd = OPERAND(p); + switch (OP(preg, p)) { + case ANY: + + while (!reg_iseol(preg, *scan) && count < max) { + count++; + scan++; + } + break; + case EXACTLY: + while (count < max) { + n = reg_utf8_tounicode_case(scan, &ch, preg->cflags & REG_ICASE); + if (preg->program[opnd] != ch) { + break; + } + count++; + scan += n; + } + break; + case ANYOF: + while (count < max) { + n = reg_utf8_tounicode_case(scan, &ch, preg->cflags & REG_ICASE); + if (reg_iseol(preg, ch) || reg_range_find(preg->program + opnd, ch) == 0) { + break; + } + count++; + scan += n; + } + break; + case ANYBUT: + while (count < max) { + n = reg_utf8_tounicode_case(scan, &ch, preg->cflags & REG_ICASE); + if (reg_iseol(preg, ch) || reg_range_find(preg->program + opnd, ch) != 0) { + break; + } + count++; + scan += n; + } + break; + default: + preg->err = REG_ERR_INTERNAL; + count = 0; + break; + } + preg->reginput = scan; + + return(count); +} + +static int regnext(regex_t *preg, int p ) +{ + int offset; + + offset = NEXT(preg, p); + + if (offset == 0) + return 0; + + if (OP(preg, p) == BACK) + return(p-offset); + else + return(p+offset); +} + +static int regopsize(regex_t *preg, int p ) +{ + + switch (OP(preg, p)) { + case REP: + case REPMIN: + case REPX: + case REPXMIN: + return 5; + + case ANYOF: + case ANYBUT: + case EXACTLY: { + int s = p + 2; + while (preg->program[s++]) { + } + return s - p; + } + } + return 2; +} + + +size_t regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size) +{ + static const char *error_strings[] = { + "success", + "no match", + "bad pattern", + "null argument", + "unknown error", + "too big", + "out of memory", + "too many ()", + "parentheses () not balanced", + "braces {} not balanced", + "invalid repetition count(s)", + "extra characters", + "*+ of empty atom", + "nested count", + "internal error", + "count follows nothing", + "trailing backslash", + "corrupted program", + "contains null char", + }; + const char *err; + + if (errcode < 0 || errcode >= REG_ERR_NUM) { + err = "Bad error code"; + } + else { + err = error_strings[errcode]; + } + + return snprintf(errbuf, errbuf_size, "%s", err); +} + +void regfree(regex_t *preg) +{ + free(preg->program); +} + +#endif +#include + +void Jim_SetResultErrno(Jim_Interp *interp, const char *msg) +{ + Jim_SetResultFormatted(interp, "%s: %s", msg, strerror(Jim_Errno())); +} + +#if defined(__MINGW32__) +#include + +int Jim_Errno(void) +{ + switch (GetLastError()) { + case ERROR_FILE_NOT_FOUND: return ENOENT; + case ERROR_PATH_NOT_FOUND: return ENOENT; + case ERROR_TOO_MANY_OPEN_FILES: return EMFILE; + case ERROR_ACCESS_DENIED: return EACCES; + case ERROR_INVALID_HANDLE: return EBADF; + case ERROR_BAD_ENVIRONMENT: return E2BIG; + case ERROR_BAD_FORMAT: return ENOEXEC; + case ERROR_INVALID_ACCESS: return EACCES; + case ERROR_INVALID_DRIVE: return ENOENT; + case ERROR_CURRENT_DIRECTORY: return EACCES; + case ERROR_NOT_SAME_DEVICE: return EXDEV; + case ERROR_NO_MORE_FILES: return ENOENT; + case ERROR_WRITE_PROTECT: return EROFS; + case ERROR_BAD_UNIT: return ENXIO; + case ERROR_NOT_READY: return EBUSY; + case ERROR_BAD_COMMAND: return EIO; + case ERROR_CRC: return EIO; + case ERROR_BAD_LENGTH: return EIO; + case ERROR_SEEK: return EIO; + case ERROR_WRITE_FAULT: return EIO; + case ERROR_READ_FAULT: return EIO; + case ERROR_GEN_FAILURE: return EIO; + case ERROR_SHARING_VIOLATION: return EACCES; + case ERROR_LOCK_VIOLATION: return EACCES; + case ERROR_SHARING_BUFFER_EXCEEDED: return ENFILE; + case ERROR_HANDLE_DISK_FULL: return ENOSPC; + case ERROR_NOT_SUPPORTED: return ENODEV; + case ERROR_REM_NOT_LIST: return EBUSY; + case ERROR_DUP_NAME: return EEXIST; + case ERROR_BAD_NETPATH: return ENOENT; + case ERROR_NETWORK_BUSY: return EBUSY; + case ERROR_DEV_NOT_EXIST: return ENODEV; + case ERROR_TOO_MANY_CMDS: return EAGAIN; + case ERROR_ADAP_HDW_ERR: return EIO; + case ERROR_BAD_NET_RESP: return EIO; + case ERROR_UNEXP_NET_ERR: return EIO; + case ERROR_NETNAME_DELETED: return ENOENT; + case ERROR_NETWORK_ACCESS_DENIED: return EACCES; + case ERROR_BAD_DEV_TYPE: return ENODEV; + case ERROR_BAD_NET_NAME: return ENOENT; + case ERROR_TOO_MANY_NAMES: return ENFILE; + case ERROR_TOO_MANY_SESS: return EIO; + case ERROR_SHARING_PAUSED: return EAGAIN; + case ERROR_REDIR_PAUSED: return EAGAIN; + case ERROR_FILE_EXISTS: return EEXIST; + case ERROR_CANNOT_MAKE: return ENOSPC; + case ERROR_OUT_OF_STRUCTURES: return ENFILE; + case ERROR_ALREADY_ASSIGNED: return EEXIST; + case ERROR_INVALID_PASSWORD: return EPERM; + case ERROR_NET_WRITE_FAULT: return EIO; + case ERROR_NO_PROC_SLOTS: return EAGAIN; + case ERROR_DISK_CHANGE: return EXDEV; + case ERROR_BROKEN_PIPE: return EPIPE; + case ERROR_OPEN_FAILED: return ENOENT; + case ERROR_DISK_FULL: return ENOSPC; + case ERROR_NO_MORE_SEARCH_HANDLES: return EMFILE; + case ERROR_INVALID_TARGET_HANDLE: return EBADF; + case ERROR_INVALID_NAME: return ENOENT; + case ERROR_PROC_NOT_FOUND: return ESRCH; + case ERROR_WAIT_NO_CHILDREN: return ECHILD; + case ERROR_CHILD_NOT_COMPLETE: return ECHILD; + case ERROR_DIRECT_ACCESS_HANDLE: return EBADF; + case ERROR_SEEK_ON_DEVICE: return ESPIPE; + case ERROR_BUSY_DRIVE: return EAGAIN; + case ERROR_DIR_NOT_EMPTY: return EEXIST; + case ERROR_NOT_LOCKED: return EACCES; + case ERROR_BAD_PATHNAME: return ENOENT; + case ERROR_LOCK_FAILED: return EACCES; + case ERROR_ALREADY_EXISTS: return EEXIST; + case ERROR_FILENAME_EXCED_RANGE: return ENAMETOOLONG; + case ERROR_BAD_PIPE: return EPIPE; + case ERROR_PIPE_BUSY: return EAGAIN; + case ERROR_PIPE_NOT_CONNECTED: return EPIPE; + case ERROR_DIRECTORY: return ENOTDIR; + } + return EINVAL; +} + +pidtype waitpid(pidtype pid, int *status, int nohang) +{ + DWORD ret = WaitForSingleObject(pid, nohang ? 0 : INFINITE); + if (ret == WAIT_TIMEOUT || ret == WAIT_FAILED) { + + return JIM_BAD_PID; + } + GetExitCodeProcess(pid, &ret); + *status = ret; + CloseHandle(pid); + return pid; +} + +int Jim_MakeTempFile(Jim_Interp *interp, const char *filename_template, int unlink_file) +{ + char name[MAX_PATH]; + HANDLE handle; + + if (!GetTempPath(MAX_PATH, name) || !GetTempFileName(name, filename_template ? filename_template : "JIM", 0, name)) { + return -1; + } + + handle = CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, NULL, + CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | (unlink_file ? FILE_FLAG_DELETE_ON_CLOSE : 0), + NULL); + + if (handle == INVALID_HANDLE_VALUE) { + goto error; + } + + Jim_SetResultString(interp, name, -1); + return _open_osfhandle((int)handle, _O_RDWR | _O_TEXT); + + error: + Jim_SetResultErrno(interp, name); + DeleteFile(name); + return -1; +} + +int Jim_OpenForWrite(const char *filename, int append) +{ + if (strcmp(filename, "/dev/null") == 0) { + filename = "nul:"; + } + int fd = _open(filename, _O_WRONLY | _O_CREAT | _O_TEXT | (append ? _O_APPEND : _O_TRUNC), _S_IREAD | _S_IWRITE); + if (fd >= 0 && append) { + + _lseek(fd, 0L, SEEK_END); + } + return fd; +} + +int Jim_OpenForRead(const char *filename) +{ + if (strcmp(filename, "/dev/null") == 0) { + filename = "nul:"; + } + return _open(filename, _O_RDONLY | _O_TEXT, 0); +} + +#elif defined(HAVE_UNISTD_H) + + + +int Jim_MakeTempFile(Jim_Interp *interp, const char *filename_template, int unlink_file) +{ + int fd; + mode_t mask; + Jim_Obj *filenameObj; + + if (filename_template == NULL) { + const char *tmpdir = getenv("TMPDIR"); + if (tmpdir == NULL || *tmpdir == '\0' || access(tmpdir, W_OK) != 0) { + tmpdir = "/tmp/"; + } + filenameObj = Jim_NewStringObj(interp, tmpdir, -1); + if (tmpdir[0] && tmpdir[strlen(tmpdir) - 1] != '/') { + Jim_AppendString(interp, filenameObj, "/", 1); + } + Jim_AppendString(interp, filenameObj, "tcl.tmp.XXXXXX", -1); + } + else { + filenameObj = Jim_NewStringObj(interp, filename_template, -1); + } + + + mask = umask(S_IXUSR | S_IRWXG | S_IRWXO); +#ifdef HAVE_MKSTEMP + fd = mkstemp(filenameObj->bytes); +#else + if (mktemp(filenameObj->bytes) == NULL) { + fd = -1; + } + else { + fd = open(filenameObj->bytes, O_RDWR | O_CREAT | O_TRUNC); + } +#endif + umask(mask); + if (fd < 0) { + Jim_SetResultErrno(interp, Jim_String(filenameObj)); + Jim_FreeNewObj(interp, filenameObj); + return -1; + } + if (unlink_file) { + remove(Jim_String(filenameObj)); + } + + Jim_SetResult(interp, filenameObj); + return fd; +} + +int Jim_OpenForWrite(const char *filename, int append) +{ + return open(filename, O_WRONLY | O_CREAT | (append ? O_APPEND : O_TRUNC), 0666); +} + +int Jim_OpenForRead(const char *filename) +{ + return open(filename, O_RDONLY, 0); +} + +#endif + +#if defined(_WIN32) || defined(WIN32) +#ifndef STRICT +#define STRICT +#endif +#define WIN32_LEAN_AND_MEAN +#include + +#if defined(HAVE_DLOPEN_COMPAT) +void *dlopen(const char *path, int mode) +{ + JIM_NOTUSED(mode); + + return (void *)LoadLibraryA(path); +} + +int dlclose(void *handle) +{ + FreeLibrary((HANDLE)handle); + return 0; +} + +void *dlsym(void *handle, const char *symbol) +{ + return GetProcAddress((HMODULE)handle, symbol); +} + +char *dlerror(void) +{ + static char msg[121]; + FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(), + LANG_NEUTRAL, msg, sizeof(msg) - 1, NULL); + return msg; +} +#endif + +#ifdef _MSC_VER + +#include + + +int gettimeofday(struct timeval *tv, void *unused) +{ + struct _timeb tb; + + _ftime(&tb); + tv->tv_sec = tb.time; + tv->tv_usec = tb.millitm * 1000; + + return 0; +} + + +DIR *opendir(const char *name) +{ + DIR *dir = 0; + + if (name && name[0]) { + size_t base_length = strlen(name); + const char *all = + strchr("/\\", name[base_length - 1]) ? "*" : "/*"; + + if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 && + (dir->name = (char *)Jim_Alloc(base_length + strlen(all) + 1)) != 0) { + strcat(strcpy(dir->name, name), all); + + if ((dir->handle = (long)_findfirst(dir->name, &dir->info)) != -1) + dir->result.d_name = 0; + else { + Jim_Free(dir->name); + Jim_Free(dir); + dir = 0; + } + } + else { + Jim_Free(dir); + dir = 0; + errno = ENOMEM; + } + } + else { + errno = EINVAL; + } + return dir; +} + +int closedir(DIR * dir) +{ + int result = -1; + + if (dir) { + if (dir->handle != -1) + result = _findclose(dir->handle); + Jim_Free(dir->name); + Jim_Free(dir); + } + if (result == -1) + errno = EBADF; + return result; +} + +struct dirent *readdir(DIR * dir) +{ + struct dirent *result = 0; + + if (dir && dir->handle != -1) { + if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) { + result = &dir->result; + result->d_name = dir->info.name; + } + } + else { + errno = EBADF; + } + return result; +} +#endif +#endif +#include +#include + + + + + + +#ifndef SIGPIPE +#define SIGPIPE 13 +#endif +#ifndef SIGINT +#define SIGINT 2 +#endif + +const char *Jim_SignalId(int sig) +{ + static char buf[10]; + switch (sig) { + case SIGINT: return "SIGINT"; + case SIGPIPE: return "SIGPIPE"; + + } + snprintf(buf, sizeof(buf), "%d", sig); + return buf; +} +#ifndef JIM_BOOTSTRAP_LIB_ONLY +#include +#include + + +#ifdef USE_LINENOISE +#ifdef HAVE_UNISTD_H + #include +#endif +#ifdef HAVE_SYS_STAT_H + #include +#endif +#include "linenoise.h" +#else +#define MAX_LINE_LEN 512 +#endif + +#ifdef USE_LINENOISE +static void JimCompletionCallback(const char *prefix, linenoiseCompletions *comp, void *userdata); +static const char completion_callback_assoc_key[] = "interactive-completion"; +#endif + +char *Jim_HistoryGetline(Jim_Interp *interp, const char *prompt) +{ +#ifdef USE_LINENOISE + struct JimCompletionInfo *compinfo = Jim_GetAssocData(interp, completion_callback_assoc_key); + char *result; + Jim_Obj *objPtr; + long mlmode = 0; + if (compinfo) { + linenoiseSetCompletionCallback(JimCompletionCallback, compinfo); + } + objPtr = Jim_GetVariableStr(interp, "history::multiline", JIM_NONE); + if (objPtr && Jim_GetLong(interp, objPtr, &mlmode) == JIM_NONE) { + linenoiseSetMultiLine(mlmode); + } + + result = linenoise(prompt); + + linenoiseSetCompletionCallback(NULL, NULL); + return result; +#else + int len; + char *line = malloc(MAX_LINE_LEN); + + fputs(prompt, stdout); + fflush(stdout); + + if (fgets(line, MAX_LINE_LEN, stdin) == NULL) { + free(line); + return NULL; + } + len = strlen(line); + if (len && line[len - 1] == '\n') { + line[len - 1] = '\0'; + } + return line; +#endif +} + +void Jim_HistoryLoad(const char *filename) +{ +#ifdef USE_LINENOISE + linenoiseHistoryLoad(filename); +#endif +} + +void Jim_HistoryAdd(const char *line) +{ +#ifdef USE_LINENOISE + linenoiseHistoryAdd(line); +#endif +} + +void Jim_HistorySave(const char *filename) +{ +#ifdef USE_LINENOISE +#ifdef HAVE_UMASK + mode_t mask; + + mask = umask(S_IXUSR | S_IRWXG | S_IRWXO); +#endif + linenoiseHistorySave(filename); +#ifdef HAVE_UMASK + umask(mask); +#endif +#endif +} + +void Jim_HistoryShow(void) +{ +#ifdef USE_LINENOISE + + int i; + int len; + char **history = linenoiseHistory(&len); + for (i = 0; i < len; i++) { + printf("%4d %s\n", i + 1, history[i]); + } +#endif +} + +#ifdef USE_LINENOISE +struct JimCompletionInfo { + Jim_Interp *interp; + Jim_Obj *command; +}; + +static void JimCompletionCallback(const char *prefix, linenoiseCompletions *comp, void *userdata) +{ + struct JimCompletionInfo *info = (struct JimCompletionInfo *)userdata; + Jim_Obj *objv[2]; + int ret; + + objv[0] = info->command; + objv[1] = Jim_NewStringObj(info->interp, prefix, -1); + + ret = Jim_EvalObjVector(info->interp, 2, objv); + + + if (ret == JIM_OK) { + int i; + Jim_Obj *listObj = Jim_GetResult(info->interp); + int len = Jim_ListLength(info->interp, listObj); + for (i = 0; i < len; i++) { + linenoiseAddCompletion(comp, Jim_String(Jim_ListGetIndex(info->interp, listObj, i))); + } + } +} + +static void JimHistoryFreeCompletion(Jim_Interp *interp, void *data) +{ + struct JimCompletionInfo *compinfo = data; + + Jim_DecrRefCount(interp, compinfo->command); + + Jim_Free(compinfo); +} +#endif + +void Jim_HistorySetCompletion(Jim_Interp *interp, Jim_Obj *commandObj) +{ +#ifdef USE_LINENOISE + if (commandObj) { + + Jim_IncrRefCount(commandObj); + } + + Jim_DeleteAssocData(interp, completion_callback_assoc_key); + + if (commandObj) { + struct JimCompletionInfo *compinfo = Jim_Alloc(sizeof(*compinfo)); + compinfo->interp = interp; + compinfo->command = commandObj; + + Jim_SetAssocData(interp, completion_callback_assoc_key, JimHistoryFreeCompletion, compinfo); + } +#endif +} + +int Jim_InteractivePrompt(Jim_Interp *interp) +{ + int retcode = JIM_OK; + char *history_file = NULL; +#ifdef USE_LINENOISE + const char *home; + + home = getenv("HOME"); + if (home && isatty(STDIN_FILENO)) { + int history_len = strlen(home) + sizeof("/.jim_history"); + history_file = Jim_Alloc(history_len); + snprintf(history_file, history_len, "%s/.jim_history", home); + Jim_HistoryLoad(history_file); + } + + Jim_HistorySetCompletion(interp, Jim_NewStringObj(interp, "tcl::autocomplete", -1)); +#endif + + printf("Welcome to Jim version %d.%d\n", + JIM_VERSION / 100, JIM_VERSION % 100); + Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, "1"); + + while (1) { + Jim_Obj *scriptObjPtr; + const char *result; + int reslen; + char prompt[20]; + + if (retcode != JIM_OK) { + const char *retcodestr = Jim_ReturnCode(retcode); + + if (*retcodestr == '?') { + snprintf(prompt, sizeof(prompt) - 3, "[%d] . ", retcode); + } + else { + snprintf(prompt, sizeof(prompt) - 3, "[%s] . ", retcodestr); + } + } + else { + strcpy(prompt, ". "); + } + + scriptObjPtr = Jim_NewStringObj(interp, "", 0); + Jim_IncrRefCount(scriptObjPtr); + while (1) { + char state; + char *line; + + line = Jim_HistoryGetline(interp, prompt); + if (line == NULL) { + if (errno == EINTR) { + continue; + } + Jim_DecrRefCount(interp, scriptObjPtr); + retcode = JIM_OK; + goto out; + } + if (Jim_Length(scriptObjPtr) != 0) { + + Jim_AppendString(interp, scriptObjPtr, "\n", 1); + } + Jim_AppendString(interp, scriptObjPtr, line, -1); + free(line); + if (Jim_ScriptIsComplete(interp, scriptObjPtr, &state)) + break; + + snprintf(prompt, sizeof(prompt), "%c> ", state); + } +#ifdef USE_LINENOISE + if (strcmp(Jim_String(scriptObjPtr), "h") == 0) { + + Jim_HistoryShow(); + Jim_DecrRefCount(interp, scriptObjPtr); + continue; + } + + Jim_HistoryAdd(Jim_String(scriptObjPtr)); + if (history_file) { + Jim_HistorySave(history_file); + } +#endif + retcode = Jim_EvalObj(interp, scriptObjPtr); + Jim_DecrRefCount(interp, scriptObjPtr); + + if (retcode == JIM_EXIT) { + break; + } + if (retcode == JIM_ERR) { + Jim_MakeErrorMessage(interp); + } + result = Jim_GetString(Jim_GetResult(interp), &reslen); + if (reslen) { + printf("%s\n", result); + } + } + out: + Jim_Free(history_file); + + return retcode; +} + +#include +#include +#include + + + +extern int Jim_initjimshInit(Jim_Interp *interp); + +static void JimSetArgv(Jim_Interp *interp, int argc, char *const argv[]) +{ + int n; + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + + + for (n = 0; n < argc; n++) { + Jim_Obj *obj = Jim_NewStringObj(interp, argv[n], -1); + + Jim_ListAppendElement(interp, listObj, obj); + } + + Jim_SetVariableStr(interp, "argv", listObj); + Jim_SetVariableStr(interp, "argc", Jim_NewIntObj(interp, argc)); +} + +static void JimPrintErrorMessage(Jim_Interp *interp) +{ + Jim_MakeErrorMessage(interp); + fprintf(stderr, "%s\n", Jim_String(Jim_GetResult(interp))); +} + +void usage(const char* executable_name) +{ + printf("jimsh version %d.%d\n", JIM_VERSION / 100, JIM_VERSION % 100); + printf("Usage: %s\n", executable_name); + printf("or : %s [options] [filename]\n", executable_name); + printf("\n"); + printf("Without options: Interactive mode\n"); + printf("\n"); + printf("Options:\n"); + printf(" --version : prints the version string\n"); + printf(" --help : prints this text\n"); + printf(" -e CMD : executes command CMD\n"); + printf(" NOTE: all subsequent options will be passed as arguments to the command\n"); + printf(" [filename|-] : executes the script contained in the named file, or from stdin if \"-\"\n"); + printf(" NOTE: all subsequent options will be passed to the script\n\n"); +} + +int main(int argc, char *const argv[]) +{ + int retcode; + Jim_Interp *interp; + char *const orig_argv0 = argv[0]; + + + if (argc > 1 && strcmp(argv[1], "--version") == 0) { + printf("%d.%d\n", JIM_VERSION / 100, JIM_VERSION % 100); + return 0; + } + else if (argc > 1 && strcmp(argv[1], "--help") == 0) { + usage(argv[0]); + return 0; + } + + + interp = Jim_CreateInterp(); + Jim_RegisterCoreCommands(interp); + + + if (Jim_InitStaticExtensions(interp) != JIM_OK) { + JimPrintErrorMessage(interp); + } + + Jim_SetVariableStrWithStr(interp, "jim::argv0", orig_argv0); + Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, argc == 1 ? "1" : "0"); + retcode = Jim_initjimshInit(interp); + + if (argc == 1) { + + if (retcode == JIM_ERR) { + JimPrintErrorMessage(interp); + } + if (retcode != JIM_EXIT) { + JimSetArgv(interp, 0, NULL); + retcode = Jim_InteractivePrompt(interp); + } + } + else { + + if (argc > 2 && strcmp(argv[1], "-e") == 0) { + + JimSetArgv(interp, argc - 3, argv + 3); + retcode = Jim_Eval(interp, argv[2]); + if (retcode != JIM_ERR) { + printf("%s\n", Jim_String(Jim_GetResult(interp))); + } + } + else { + Jim_SetVariableStr(interp, "argv0", Jim_NewStringObj(interp, argv[1], -1)); + JimSetArgv(interp, argc - 2, argv + 2); + if (strcmp(argv[1], "-") == 0) { + retcode = Jim_Eval(interp, "eval [info source [stdin read] stdin 1]"); + } else { + retcode = Jim_EvalFile(interp, argv[1]); + } + } + if (retcode == JIM_ERR) { + JimPrintErrorMessage(interp); + } + } + if (retcode == JIM_EXIT) { + retcode = Jim_GetExitCode(interp); + } + else if (retcode == JIM_ERR) { + retcode = 1; + } + else { + retcode = 0; + } + Jim_FreeInterp(interp); + return retcode; +} +#endif diff -Nru jimtcl-0.79+dfsg0/autosetup/local.tcl jimtcl-0.81+dfsg0/autosetup/local.tcl --- jimtcl-0.79+dfsg0/autosetup/local.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/local.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -59,13 +59,34 @@ set use_pkgconfig 0 set pkgconfig [ext-get $ext pkg-config] if {$pkgconfig ne ""} { - # pkg-config support is optional, so explicitly initialse it here + # pkg-config support is optional, so explicitly initialise it here if {[pkg-config-init 0]} { - lassign $pkgconfig pkg args - - if {[pkg-config {*}$pkgconfig]} { - # Found via pkg-config so ignore check and libdep - set use_pkgconfig 1 + # Check for at least one set of alternates + foreach pinfo [split $pkgconfig |] { + set ok 1 + set pkgs {} + foreach pkg [split $pinfo ,] { + set args [lassign $pkg pkgname] + set pkg [string trim $pkg] + set optional 0 + if {[string match {*[*]} $pkg]} { + # This package is optional + set optional 1 + set pkg [string range $pkg 0 end-1] + } + if {![pkg-config $pkg {*}$args]} { + if {!$optional} { + set ok 0 + break + } + } else { + lappend pkgs $pkg + } + } + if {$ok} { + set use_pkgconfig 1 + break + } } } } @@ -124,10 +145,7 @@ } else { msg-result "Extension $ext...module" if {$use_pkgconfig} { - define-append LDLIBS_$ext [pkg-config-get $pkg LIBS] - define-append LDFLAGS [pkg-config-get $pkg LDFLAGS] - define-append CCOPTS [pkg-config-get $pkg CFLAGS] - define-append PKG_CONFIG_REQUIRES $pkg + add-pkgconfig-deps $ext $pkgs $asmodule } else { foreach i [ext-get $ext libdep] { define-append LDLIBS_$ext [get-define $i ""] @@ -149,10 +167,7 @@ return [ext-set-status $ext x] } if {$use_pkgconfig} { - define-append LDLIBS [pkg-config-get $pkg LIBS] - define-append LDFLAGS [pkg-config-get $pkg LDFLAGS] - define-append CCOPTS [pkg-config-get $pkg CFLAGS] - define-append PKG_CONFIG_REQUIRES $pkg + add-pkgconfig-deps $ext $pkgs $asmodule } else { foreach i [ext-get $ext libdep] { define-append LDLIBS [get-define $i ""] @@ -161,17 +176,34 @@ return [ext-set-status $ext y] } +# Add dependencies for a pkg-config module to the extension +proc add-pkgconfig-deps {ext pkgs asmodule} { + foreach pkg $pkgs { + if {$asmodule} { + define-append LDLIBS_$ext [pkg-config-get $pkg LIBS] + } else { + define-append LDLIBS [pkg-config-get $pkg LIBS] + } + define-append LDFLAGS [pkg-config-get $pkg LDFLAGS] + define-append CCOPTS [pkg-config-get $pkg CFLAGS] + define-append PKG_CONFIG_REQUIRES $pkg + } +} + # Examines the user options (the $withinfo array) # and the extension database ($extdb) to determine # what is selected, and in what way. # +# If $allextmod is 1, extensions that would normally be disabled +# are enabled as modules if their prerequisites are met +# # The results are available via ext-get-status # And a dictionary is returned containing four keys: # static-c extensions which are static C # static-tcl extensions which are static Tcl # module-c extensions which are C modules # module-tcl extensions which are Tcl modules -proc check-extensions {} { +proc check-extensions {allextmod} { global extdb withinfo # Check valid extension names @@ -184,6 +216,7 @@ set extlist [lsort [dict keys [dict get $extdb attrs]]] set withinfo(maybe) {} + set withinfo(maybemod) {} # Now work out the default status. We have. # normal case, include !off, !optional if possible @@ -194,9 +227,15 @@ } else { foreach i $extlist { if {[ext-has $i off]} { + if {$allextmod} { + lappend withinfo(maybemod) $i + } continue } if {[ext-has $i optional] && !$withinfo(optional)} { + if {$allextmod} { + lappend withinfo(maybemod) $i + } continue } lappend withinfo(maybe) $i @@ -213,6 +252,9 @@ foreach i $withinfo(maybe) { check-extension-status $i wanted } + foreach i $withinfo(maybemod) { + check-extension-status $i wanted 1 + } array set extinfo {static-c {} static-tcl {} module-c {} module-tcl {}} diff -Nru jimtcl-0.79+dfsg0/autosetup/pkg-config.tcl jimtcl-0.81+dfsg0/autosetup/pkg-config.tcl --- jimtcl-0.79+dfsg0/autosetup/pkg-config.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/pkg-config.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -15,7 +15,7 @@ use cc -module-options { +options { sysroot:dir => "Override compiler sysroot for pkg-config search path" } @@ -53,11 +53,12 @@ define SYSROOT [file-normalize $o] msg-result "Using specified sysroot [get-define SYSROOT]" } elseif {[get-define build] ne [get-define host]} { - if {[catch {exec-with-stderr [get-define CC] -print-sysroot} result errinfo] == 0} { + if {[catch {exec-with-stderr {*}[get-define CC] -print-sysroot} result errinfo] == 0} { # Use the compiler sysroot, if there is one define SYSROOT $result msg-result "Found compiler sysroot $result" } else { + configlog "[get-define CC] -print-sysroot: $result" set msg "pkg-config: Cross compiling, but no compiler sysroot and no --sysroot supplied" if {$required} { user-error $msg @@ -73,6 +74,9 @@ # XXX: It's possible that these should be set only when invoking pkg-config global env set env(PKG_CONFIG_DIR) "" + # Supposedly setting PKG_CONFIG_LIBDIR means that PKG_CONFIG_PATH is ignored, + # but it doesn't seem to work that way in practice + set env(PKG_CONFIG_PATH) "" # Do we need to try /usr/local as well or instead? set env(PKG_CONFIG_LIBDIR) $sysroot/usr/lib/pkgconfig:$sysroot/usr/share/pkgconfig set env(PKG_CONFIG_SYSROOT_DIR) $sysroot @@ -108,18 +112,30 @@ return 0 } - if {[catch {exec [get-define PKG_CONFIG] --modversion "$module $args"} version]} { + set pkgconfig [get-define PKG_CONFIG] + + set ret [catch {exec $pkgconfig --modversion "$module $args"} version] + configlog "$pkgconfig --modversion $module $args: $version" + if {$ret} { msg-result "not found" - configlog "pkg-config --modversion $module $args: $version" + return 0 + } + # Sometimes --modversion succeeds but because of dependencies it isn't usable + # This seems to show up with --cflags + set ret [catch {exec $pkgconfig --cflags $module} cflags] + if {$ret} { + msg-result "unusable ($version - see config.log)" + configlog "$pkgconfig --cflags $module" + configlog $cflags return 0 } msg-result $version set prefix [feature-define-name $module PKG_] define HAVE_${prefix} define ${prefix}_VERSION $version - define ${prefix}_LIBS [exec pkg-config --libs-only-l $module] - define ${prefix}_LDFLAGS [exec pkg-config --libs-only-L $module] - define ${prefix}_CFLAGS [exec pkg-config --cflags $module] + define ${prefix}_CFLAGS $cflags + define ${prefix}_LIBS [exec $pkgconfig --libs-only-l $module] + define ${prefix}_LDFLAGS [exec $pkgconfig --libs-only-L $module] return 1 } @@ -133,3 +149,20 @@ set prefix [feature-define-name $module PKG_] get-define ${prefix}_${name} "" } + +# @pkg-config-get-var module variable +# +# Return the value of the given variable from the given pkg-config module. +# The module must already have been successfully detected with pkg-config. +# e.g. +# +## if {[pkg-config harfbuzz >= 2.5]} { +## define harfbuzz_libdir [pkg-config-get-var harfbuzz libdir] +## } +# +# Returns the empty string if the variable isn't defined. +proc pkg-config-get-var {module variable} { + set pkgconfig [get-define PKG_CONFIG] + set prefix [feature-define-name $module HAVE_PKG_] + exec $pkgconfig $module --variable $variable +} diff -Nru jimtcl-0.79+dfsg0/autosetup/README.autosetup jimtcl-0.81+dfsg0/autosetup/README.autosetup --- jimtcl-0.79+dfsg0/autosetup/README.autosetup 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/README.autosetup 2021-11-27 23:06:54.000000000 +0000 @@ -1,4 +1,4 @@ -README.autosetup created by autosetup v0.6.9 +README.autosetup created by autosetup v0.7.0+ This is the autosetup directory for a local install of autosetup. It contains autosetup, support files and loadable modules. @@ -8,4 +8,4 @@ *.auto files in this directory are auto-loaded. -For more information, see http://msteveb.github.com/autosetup/ +For more information, see http://msteveb.github.io/autosetup/ diff -Nru jimtcl-0.79+dfsg0/autosetup/system.tcl jimtcl-0.81+dfsg0/autosetup/system.tcl --- jimtcl-0.79+dfsg0/autosetup/system.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/system.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -27,7 +27,7 @@ options-defaults [list prefix [get-define defaultprefix]] } -module-options [subst -noc -nob { +options { host:host-alias => {a complete or partial cpu-vendor-opsys for the system where the application will run (defaults to the same value as --build)} build:build-alias => {a complete or partial cpu-vendor-opsys for the system @@ -52,7 +52,7 @@ maintainer-mode=0 dependency-tracking=0 silent-rules=0 -}] +} # @check-feature name { script } # diff -Nru jimtcl-0.79+dfsg0/autosetup/tmake.tcl jimtcl-0.81+dfsg0/autosetup/tmake.tcl --- jimtcl-0.79+dfsg0/autosetup/tmake.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/autosetup/tmake.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -11,7 +11,7 @@ use system -module-options {} +options {} define CONFIGURED diff -Nru jimtcl-0.79+dfsg0/bootstrap.tcl jimtcl-0.81+dfsg0/bootstrap.tcl --- jimtcl-0.79+dfsg0/bootstrap.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/bootstrap.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -1,16 +1,16 @@ # Minimal support for package require -# No error on failure since C extensions aren't handled -proc package {cmd pkg args} { +proc package {cmd args} { if {$cmd eq "require"} { foreach path $::auto_path { + lassign $args pkg set pkgpath $path/$pkg.tcl if {$path eq "."} { set pkgpath $pkg.tcl } if {[file exists $pkgpath]} { - uplevel #0 [list source $pkgpath] - return + tailcall uplevel #0 [list source $pkgpath] } } } } +set tcl_platform(bootstrap) 1 diff -Nru jimtcl-0.79+dfsg0/configure.ac jimtcl-0.81+dfsg0/configure.ac --- jimtcl-0.79+dfsg0/configure.ac 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/configure.ac 2021-11-27 23:06:54.000000000 +0000 @@ -1 +1,3 @@ # Dummy configure.ac to make automake happy +AC_INIT([jimtcl], [0.80]) +AC_OUTPUT diff -Nru jimtcl-0.79+dfsg0/debian/changelog jimtcl-0.81+dfsg0/debian/changelog --- jimtcl-0.79+dfsg0/debian/changelog 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/changelog 2022-05-28 07:35:15.000000000 +0000 @@ -1,3 +1,21 @@ +jimtcl (0.81+dfsg0-2) unstable; urgency=medium + + * fix vcs url. + * upload to unstable + + -- Bo YU Sat, 28 May 2022 15:35:15 +0800 + +jimtcl (0.81+dfsg0-1) experimental; urgency=medium + + * Update to new upstream version 0.81 + - Bump libjim SONAME from 0.79 to 0.81 + - Rebase pacthes; drop upstream backports + - Add debian/watch file + + * Add myself as maintainer (Closes: #993599). + + -- Bo YU Tue, 22 Mar 2022 10:15:19 +0800 + jimtcl (0.79+dfsg0-3) unstable; urgency=medium * Orphan package diff -Nru jimtcl-0.79+dfsg0/debian/control jimtcl-0.81+dfsg0/debian/control --- jimtcl-0.79+dfsg0/debian/control 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/control 2022-05-28 07:35:15.000000000 +0000 @@ -1,5 +1,5 @@ Source: jimtcl -Maintainer: Debian QA Group +Maintainer: Bo YU Section: devel Priority: optional Build-Depends: @@ -31,7 +31,7 @@ Multi-Arch: same Section: libdevel Depends: - libjim0.79 (= ${binary:Version}), + libjim0.81 (= ${binary:Version}), ${misc:Depends}, Description: small-footprint implementation of Tcl - development files Jim is an opensource small-footprint implementation of the Tcl programming @@ -43,7 +43,7 @@ . This package provides the libjim development files. -Package: libjim0.79 +Package: libjim0.81 Architecture: any Multi-Arch: same Section: libs diff -Nru jimtcl-0.79+dfsg0/debian/copyright jimtcl-0.81+dfsg0/debian/copyright --- jimtcl-0.79+dfsg0/debian/copyright 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/copyright 2022-05-28 07:35:15.000000000 +0000 @@ -16,7 +16,7 @@ 2009 David Brownell License: BSD-2-clause -Files: autosetup/ +Files: autosetup/* Copyright: 2006-2011, WorkWare Systems License: BSD-2-clause @@ -71,7 +71,7 @@ permission to use and distribute the software in accordance with the terms specified in this license. -Files: debian/ +Files: debian/* Copyright: 2011 Edgar Grimberg 2011 Steve Bennett 2011-2014 Didier Raboud diff -Nru jimtcl-0.79+dfsg0/debian/gbp.conf jimtcl-0.81+dfsg0/debian/gbp.conf --- jimtcl-0.79+dfsg0/debian/gbp.conf 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/gbp.conf 2022-05-28 07:35:15.000000000 +0000 @@ -1,4 +1,4 @@ [DEFAULT] -debian-branch = debian/master +debian-branch = debian/main upstream-branch = upstream/latest pristine-tar = True diff -Nru jimtcl-0.79+dfsg0/debian/libjim0.79.install jimtcl-0.81+dfsg0/debian/libjim0.79.install --- jimtcl-0.79+dfsg0/debian/libjim0.79.install 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/libjim0.79.install 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -usr/lib/*/libjim.so.* diff -Nru jimtcl-0.79+dfsg0/debian/libjim0.79.symbols jimtcl-0.81+dfsg0/debian/libjim0.79.symbols --- jimtcl-0.79+dfsg0/debian/libjim0.79.symbols 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/libjim0.79.symbols 1970-01-01 00:00:00.000000000 +0000 @@ -1,226 +0,0 @@ -libjim.so.0.79 libjim0.79 #MINVER# - JimCanonicalNamespace@Base 0.73 - JimStringReplaceObj@Base 0.73 - Jim_AddHashEntry@Base 0.72 - Jim_AioFile@Base 0.77 - Jim_AioFilehandle@Base 0.72 - Jim_Alloc@Base 0.72 - Jim_AppendObj@Base 0.72 - Jim_AppendString@Base 0.72 - Jim_AppendStrings@Base 0.72 - Jim_CallSubCmd@Base 0.72 - Jim_CheckShowCommands@Base 0.79 - Jim_Collect@Base 0.72 - Jim_CollectIfNeeded@Base 0.72 - Jim_CommandMatchObj@Base 0.72 - Jim_CompareStringImmediate@Base 0.72 - Jim_ConcatObj@Base 0.72 - Jim_CreateCommand@Base 0.72 - Jim_CreateFileHandler@Base 0.72 - Jim_CreateInterp@Base 0.72 - Jim_CreateNamespaceVariable@Base 0.73 - Jim_CreateTimeHandler@Base 0.72 - Jim_DeleteAssocData@Base 0.72 - Jim_DeleteCommand@Base 0.72 - Jim_DeleteFileHandler@Base 0.72 - Jim_DeleteHashEntry@Base 0.72 - Jim_DeleteTimeHandler@Base 0.72 - Jim_DictAddElement@Base 0.72 - Jim_DictInfo@Base 0.75 - Jim_DictKey@Base 0.72 - Jim_DictKeysVector@Base 0.72 - Jim_DictMatchTypes@Base 0.79 - Jim_DictMerge@Base 0.79 - Jim_DictPairs@Base 0.72 - Jim_DictSize@Base 0.72 - Jim_DuplicateObj@Base 0.72 - Jim_Eval@Base 0.72 - Jim_EvalExpression@Base 0.72 - Jim_EvalFile@Base 0.72 - Jim_EvalFileGlobal@Base 0.72 - Jim_EvalGlobal@Base 0.72 - Jim_EvalNamespace@Base 0.73 - Jim_EvalObj@Base 0.72 - Jim_EvalObjBackground@Base 0.72 - Jim_EvalObjList@Base 0.73 - Jim_EvalObjPrefix@Base 0.72 - Jim_EvalObjVector@Base 0.72 - Jim_EvalSource@Base 0.72 - Jim_ExpandHashTable@Base 0.72 - Jim_FindByName@Base 0.72 - Jim_FindHashEntry@Base 0.72 - Jim_FormatString@Base 0.72 - Jim_Free@Base 0.72 - Jim_FreeHashTable@Base 0.72 - Jim_FreeInterp@Base 0.72 - Jim_FreeObj@Base 0.72 - Jim_FreeStack@Base 0.72 - Jim_FreeStackElements@Base 0.72 - Jim_GenHashFunction@Base 0.72 - Jim_GetAssocData@Base 0.72 - Jim_GetBoolean@Base 0.77 - Jim_GetBoolFromExpr@Base 0.72 - Jim_GetCallFrameByLevel@Base 0.72 - Jim_GetCommand@Base 0.72 - Jim_GetDouble@Base 0.72 - Jim_GetEnum@Base 0.72 - Jim_GetEnviron@Base 0.72 - Jim_GetExitCode@Base 0.72 - Jim_GetFinalizer@Base 0.72 - Jim_GetGlobalVariable@Base 0.72 - Jim_GetGlobalVariableStr@Base 0.72 - Jim_GetHashTableIterator@Base 0.72 - Jim_GetIndex@Base 0.72 - Jim_GetLong@Base 0.72 - Jim_GetReference@Base 0.72 - Jim_GetReturnCode@Base 0.72 - Jim_GetString@Base 0.72 - Jim_GetTtySettings@Base 0.79 - Jim_GetVariable@Base 0.72 - Jim_GetVariableStr@Base 0.72 - Jim_GetWide@Base 0.72 - Jim_HistoryAdd@Base 0.73 - Jim_HistoryGetline@Base 0.73 - Jim_HistoryLoad@Base 0.73 - Jim_HistorySave@Base 0.73 - Jim_HistorySetCompletion@Base 0.79 - Jim_HistoryShow@Base 0.73 - Jim_InitHashTable@Base 0.72 - Jim_InitStack@Base 0.72 - Jim_InitStaticExtensions@Base 0.72 - Jim_IntHashFunction@Base 0.72 - Jim_InteractivePrompt@Base 0.72 - Jim_InvalidateStringRep@Base 0.72 - Jim_IsBigEndian@Base 0.75 - Jim_IsDict@Base 0.72 - Jim_IsList@Base 0.72 - Jim_Length@Base 0.72 - Jim_ListAppendElement@Base 0.72 - Jim_ListAppendList@Base 0.72 - Jim_ListGetIndex@Base 0.73 - Jim_ListIndex@Base 0.72 - Jim_ListInsertElements@Base 0.72 - Jim_ListJoin@Base 0.73 - Jim_ListLength@Base 0.72 - Jim_ListRange@Base 0.72 - Jim_ListSetIndex@Base 0.75 - Jim_LoadLibrary@Base 0.72 - Jim_MakeErrorMessage@Base 0.72 - Jim_MakeGlobalNamespaceName@Base 0.75 - Jim_MakeTempFile@Base 0.75-1~ - Jim_NamespaceQualifiers@Base 0.73 - Jim_NamespaceTail@Base 0.73 - Jim_NewDictObj@Base 0.72 - Jim_NewDoubleObj@Base 0.72 - Jim_NewIntObj@Base 0.72 - Jim_NewListObj@Base 0.72 - Jim_NewObj@Base 0.72 - Jim_NewReference@Base 0.72 - Jim_NewStringObj@Base 0.72 - Jim_NewStringObjNoAlloc@Base 0.72 - Jim_NewStringObjUtf8@Base 0.72 - Jim_NextHashEntry@Base 0.72 - Jim_OpenForRead@Base 0.79 - Jim_OpenForWrite@Base 0.79 - Jim_PackageProvide@Base 0.72 - Jim_PackageRequire@Base 0.72 - Jim_ParseSubCmd@Base 0.72 - Jim_ProcessEvents@Base 0.72 - Jim_ReaddirCmd@Base 0.72 - Jim_Realloc@Base 0.72 - Jim_RegexpCmd@Base 0.72 - Jim_RegisterCoreCommands@Base 0.72 - Jim_RegsubCmd@Base 0.72 - Jim_RenameCommand@Base 0.72 - Jim_ReplaceHashEntry@Base 0.72 - Jim_ReturnCode@Base 0.72 - Jim_ScanString@Base 0.72 - Jim_ScriptIsComplete@Base 0.72 - Jim_SetAssocData@Base 0.72 - Jim_SetDictKeysVector@Base 0.72 - Jim_SetEnviron@Base 0.72 - Jim_SetFinalizer@Base 0.72 - Jim_SetGlobalVariableStr@Base 0.72 - Jim_SetResultErrno@Base 0.79 - Jim_SetResultFormatted@Base 0.72 - Jim_SetTtySettings@Base 0.79 - Jim_SetVariable@Base 0.72 - Jim_SetVariableLink@Base 0.72 - Jim_SetVariableStr@Base 0.72 - Jim_SetVariableStrWithStr@Base 0.72 - Jim_SignalId@Base 0.72 - Jim_StackLen@Base 0.72 - Jim_StackPeek@Base 0.72 - Jim_StackPop@Base 0.72 - Jim_StackPush@Base 0.72 - Jim_StrDup@Base 0.72 - Jim_StrDupLen@Base 0.72 - Jim_String@Base 0.73 - Jim_StringByteRangeObj@Base 0.72 - Jim_StringCompareLenObj@Base 0.73 - Jim_StringCompareObj@Base 0.72 - Jim_StringEqObj@Base 0.72 - Jim_StringMatchObj@Base 0.72 - Jim_StringRangeObj@Base 0.72 - Jim_StringToDouble@Base 0.72 - Jim_StringToWide@Base 0.72 - Jim_SubCmdProc@Base 0.72 - Jim_SubstObj@Base 0.72 - Jim_SyslogCmd@Base 0.72 - Jim_UnsetVariable@Base 0.72 - Jim_Utf8Length@Base 0.72 - Jim_WrongNumArgs@Base 0.72 - Jim_aioInit@Base 0.72 - Jim_arrayInit@Base 0.72 - Jim_clockInit@Base 0.72 - Jim_eventloopInit@Base 0.72 - Jim_execInit@Base 0.72 - Jim_fileInit@Base 0.72 - Jim_globInit@Base 0.72 - Jim_historyInit@Base 0.73 - Jim_interpInit@Base 0.77 - Jim_loadInit@Base 0.72 - Jim_namespaceInit@Base 0.73 - Jim_nshelperInit@Base 0.73 - Jim_ooInit@Base 0.73 - Jim_packInit@Base 0.73 - Jim_packageInit@Base 0.72 - Jim_posixInit@Base 0.72 - Jim_readdirInit@Base 0.72 - Jim_regexpInit@Base 0.72 - Jim_signalInit@Base 0.72 - Jim_stdlibInit@Base 0.72 - Jim_syslogInit@Base 0.72 - Jim_tclcompatInit@Base 0.72 - Jim_treeInit@Base 0.73 - jim_tt_name@Base 0.72 - linenoise@Base 0.72 - linenoiseAddCompletion@Base 0.79 - linenoiseClearScreen@Base 0.79 - linenoiseColumns@Base 0.74 - linenoiseHistory@Base 0.72 - linenoiseHistoryAdd@Base 0.72 - linenoiseHistoryAddAllocated@Base 0.79 - linenoiseHistoryFree@Base 0.72 - linenoiseHistoryGetMaxLen@Base 0.74 - linenoiseHistoryLoad@Base 0.72 - linenoiseHistorySave@Base 0.72 - linenoiseHistorySetMaxLen@Base 0.72 - linenoiseSetCompletionCallback@Base 0.79 - linenoiseSetFreeHintsCallback@Base 0.79 - linenoiseSetHintsCallback@Base 0.79 - linenoiseSetMultiLine@Base 0.79 - regcomp@Base 0.73 - regerror@Base 0.73 - regexec@Base 0.73 - regfree@Base 0.73 - sb_alloc@Base 0.79 - sb_append@Base 0.79 - sb_append_len@Base 0.79 - sb_clear@Base 0.79 - sb_delete@Base 0.79 - sb_free@Base 0.79 - sb_insert@Base 0.79 - sb_realloc@Base 0.79 - sb_to_string@Base 0.79 - utf8_fromunicode@Base 0.72 diff -Nru jimtcl-0.79+dfsg0/debian/libjim0.81.install jimtcl-0.81+dfsg0/debian/libjim0.81.install --- jimtcl-0.79+dfsg0/debian/libjim0.81.install 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/libjim0.81.install 2022-05-28 07:35:15.000000000 +0000 @@ -0,0 +1 @@ +usr/lib/*/libjim.so.* diff -Nru jimtcl-0.79+dfsg0/debian/libjim0.81.symbols jimtcl-0.81+dfsg0/debian/libjim0.81.symbols --- jimtcl-0.79+dfsg0/debian/libjim0.81.symbols 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/libjim0.81.symbols 2022-05-28 07:35:15.000000000 +0000 @@ -0,0 +1,234 @@ +libjim.so.0.81 libjim0.81 #MINVER# + JimCanonicalNamespace@Base 0.73 + JimStringReplaceObj@Base 0.73 + Jim_AddHashEntry@Base 0.72 + Jim_AioFile@Base 0.77 + Jim_AioFilehandle@Base 0.72 + Jim_Alloc@Base 0.72 + Jim_AppendObj@Base 0.72 + Jim_AppendString@Base 0.72 + Jim_AppendStrings@Base 0.72 + Jim_CallSubCmd@Base 0.72 + Jim_CheckAbiVersion@Base 0.81 + Jim_CheckShowCommands@Base 0.79 + Jim_ClearHashTable@Base 0.81 + Jim_Collect@Base 0.72 + Jim_CollectIfNeeded@Base 0.72 + Jim_CommandMatchObj@Base 0.72 + Jim_CompareStringImmediate@Base 0.72 + Jim_ConcatObj@Base 0.72 + Jim_CreateCommand@Base 0.72 + Jim_CreateCommandObj@Base 0.81 + Jim_CreateFileHandler@Base 0.72 + Jim_CreateInterp@Base 0.72 + Jim_CreateNamespaceVariable@Base 0.73 + Jim_CreateScriptFileHandler@Base 0.81 + Jim_CreateTimeHandler@Base 0.72 + Jim_DeleteAssocData@Base 0.72 + Jim_DeleteCommand@Base 0.72 + Jim_DeleteFileHandler@Base 0.72 + Jim_DeleteHashEntry@Base 0.72 + Jim_DeleteTimeHandler@Base 0.72 + Jim_DictAddElement@Base 0.72 + Jim_DictInfo@Base 0.75 + Jim_DictKey@Base 0.72 + Jim_DictKeysVector@Base 0.72 + Jim_DictMatchTypes@Base 0.79 + Jim_DictMerge@Base 0.79 + Jim_DictPairs@Base 0.72 + Jim_DictSize@Base 0.72 + Jim_DuplicateObj@Base 0.72 + Jim_Eval@Base 0.72 + Jim_EvalExpression@Base 0.72 + Jim_EvalFile@Base 0.72 + Jim_EvalFileGlobal@Base 0.72 + Jim_EvalGlobal@Base 0.72 + Jim_EvalNamespace@Base 0.73 + Jim_EvalObj@Base 0.72 + Jim_EvalObjBackground@Base 0.72 + Jim_EvalObjList@Base 0.73 + Jim_EvalObjPrefix@Base 0.72 + Jim_EvalObjVector@Base 0.72 + Jim_EvalSource@Base 0.72 + Jim_ExpandHashTable@Base 0.72 + Jim_FindByName@Base 0.72 + Jim_FindFileHandler@Base 0.81 + Jim_FindHashEntry@Base 0.72 + Jim_FormatString@Base 0.72 + Jim_Free@Base 0.72 + Jim_FreeHashTable@Base 0.72 + Jim_FreeInterp@Base 0.72 + Jim_FreeObj@Base 0.72 + Jim_FreeStack@Base 0.72 + Jim_FreeStackElements@Base 0.72 + Jim_GenHashFunction@Base 0.72 + Jim_GetAssocData@Base 0.72 + Jim_GetBoolean@Base 0.77 + Jim_GetBoolFromExpr@Base 0.72 + Jim_GetCallFrameByLevel@Base 0.72 + Jim_GetCommand@Base 0.72 + Jim_GetDouble@Base 0.72 + Jim_GetEnum@Base 0.72 + Jim_GetEnviron@Base 0.72 + Jim_GetExitCode@Base 0.72 + Jim_GetFinalizer@Base 0.72 + Jim_GetGlobalVariable@Base 0.72 + Jim_GetGlobalVariableStr@Base 0.72 + Jim_GetHashTableIterator@Base 0.72 + Jim_GetIndex@Base 0.72 + Jim_GetLong@Base 0.72 + Jim_GetReference@Base 0.72 + Jim_GetReturnCode@Base 0.72 + Jim_GetString@Base 0.72 + Jim_GetTtySettings@Base 0.79 + Jim_GetVariable@Base 0.72 + Jim_GetVariableStr@Base 0.72 + Jim_GetWide@Base 0.72 + Jim_GetWideExpr@Base 0.81 + Jim_HistoryAdd@Base 0.73 + Jim_HistoryGetline@Base 0.73 + Jim_HistoryGetMaxLen@Base 0.81 + Jim_HistoryLoad@Base 0.73 + Jim_HistorySave@Base 0.73 + Jim_HistorySetCompletion@Base 0.79 + Jim_HistorySetMaxLen@Base 0.81 + Jim_HistoryShow@Base 0.73 + Jim_InitHashTable@Base 0.72 + Jim_InitStack@Base 0.72 + Jim_InitStaticExtensions@Base 0.72 + Jim_IntHashFunction@Base 0.72 + Jim_InteractivePrompt@Base 0.72 + Jim_InterpIncrProcEpoch@Base 0.81 + Jim_InvalidateStringRep@Base 0.72 + Jim_IsBigEndian@Base 0.75 + Jim_IsDict@Base 0.72 + Jim_IsList@Base 0.72 + Jim_Length@Base 0.72 + Jim_ListAppendElement@Base 0.72 + Jim_ListAppendList@Base 0.72 + Jim_ListGetIndex@Base 0.73 + Jim_ListIndex@Base 0.72 + Jim_ListInsertElements@Base 0.72 + Jim_ListJoin@Base 0.73 + Jim_ListLength@Base 0.72 + Jim_ListRange@Base 0.72 + Jim_ListSetIndex@Base 0.75 + Jim_LoadLibrary@Base 0.72 + Jim_MakeErrorMessage@Base 0.72 + Jim_MakeGlobalNamespaceName@Base 0.75 + Jim_MakeTempFile@Base 0.75-1~ + Jim_NamespaceQualifiers@Base 0.73 + Jim_NamespaceTail@Base 0.73 + Jim_NewDictObj@Base 0.72 + Jim_NewDoubleObj@Base 0.72 + Jim_NewIntObj@Base 0.72 + Jim_NewListObj@Base 0.72 + Jim_NewObj@Base 0.72 + Jim_NewReference@Base 0.72 + Jim_NewStringObj@Base 0.72 + Jim_NewStringObjNoAlloc@Base 0.72 + Jim_NewStringObjUtf8@Base 0.72 + Jim_NextHashEntry@Base 0.72 + Jim_OpenForRead@Base 0.79 + Jim_OpenForWrite@Base 0.79 + Jim_PackageProvide@Base 0.72 + Jim_PackageRequire@Base 0.72 + Jim_ParseSubCmd@Base 0.72 + Jim_ProcessEvents@Base 0.72 + Jim_ReaddirCmd@Base 0.72 + Jim_Realloc@Base 0.72 + Jim_RegexpCmd@Base 0.72 + Jim_RegisterCoreCommands@Base 0.72 + Jim_RegsubCmd@Base 0.72 + Jim_RenameCommand@Base 0.72 + Jim_ReplaceHashEntry@Base 0.72 + Jim_ReturnCode@Base 0.72 + Jim_ScanString@Base 0.72 + Jim_ScriptIsComplete@Base 0.72 + Jim_SetAssocData@Base 0.72 + Jim_SetDictKeysVector@Base 0.72 + Jim_SetEnviron@Base 0.72 + Jim_SetFinalizer@Base 0.72 + Jim_SetGlobalVariableStr@Base 0.72 + Jim_SetResultErrno@Base 0.79 + Jim_SetResultFormatted@Base 0.72 + Jim_SetTtySettings@Base 0.79 + Jim_SetVariable@Base 0.72 + Jim_SetVariableLink@Base 0.72 + Jim_SetVariableStr@Base 0.72 + Jim_SetVariableStrWithStr@Base 0.72 + Jim_SignalId@Base 0.72 + Jim_StackLen@Base 0.72 + Jim_StackPeek@Base 0.72 + Jim_StackPop@Base 0.72 + Jim_StackPush@Base 0.72 + Jim_StrDup@Base 0.72 + Jim_StrDupLen@Base 0.72 + Jim_String@Base 0.73 + Jim_StringByteRangeObj@Base 0.72 + Jim_StringCompareObj@Base 0.72 + Jim_StringEqObj@Base 0.72 + Jim_StringMatchObj@Base 0.72 + Jim_StringRangeObj@Base 0.72 + Jim_StringToDouble@Base 0.72 + Jim_StringToWide@Base 0.72 + Jim_SubCmdProc@Base 0.72 + Jim_SubstObj@Base 0.72 + Jim_SyslogCmd@Base 0.72 + Jim_UnsetVariable@Base 0.72 + Jim_Utf8Length@Base 0.72 + Jim_WrongNumArgs@Base 0.72 + Jim_aioInit@Base 0.72 + Jim_arrayInit@Base 0.72 + Jim_clockInit@Base 0.72 + Jim_eventloopInit@Base 0.72 + Jim_execInit@Base 0.72 + Jim_fileInit@Base 0.72 + Jim_globInit@Base 0.72 + Jim_historyInit@Base 0.73 + Jim_interpInit@Base 0.77 + Jim_loadInit@Base 0.72 + Jim_namespaceInit@Base 0.73 + Jim_nshelperInit@Base 0.73 + Jim_ooInit@Base 0.73 + Jim_packInit@Base 0.73 + Jim_packageInit@Base 0.72 + Jim_posixInit@Base 0.72 + Jim_readdirInit@Base 0.72 + jim_regcomp@Base 0.81 + jim_regerror@Base 0.81 + jim_regexec@Base 0.81 + Jim_regexpInit@Base 0.72 + jim_regfree@Base 0.81 + Jim_signalInit@Base 0.72 + Jim_stdlibInit@Base 0.72 + Jim_syslogInit@Base 0.72 + Jim_tclcompatInit@Base 0.72 + Jim_treeInit@Base 0.73 + jim_tt_name@Base 0.72 + linenoise@Base 0.72 + linenoiseAddCompletion@Base 0.79 + linenoiseClearScreen@Base 0.79 + linenoiseColumns@Base 0.74 + linenoiseHistory@Base 0.72 + linenoiseHistoryAdd@Base 0.72 + linenoiseHistoryAddAllocated@Base 0.79 + linenoiseHistoryFree@Base 0.72 + linenoiseHistoryGetMaxLen@Base 0.74 + linenoiseHistoryLoad@Base 0.72 + linenoiseHistorySave@Base 0.72 + linenoiseHistorySetMaxLen@Base 0.72 + linenoiseSetCompletionCallback@Base 0.79 + linenoiseSetFreeHintsCallback@Base 0.79 + linenoiseSetHintsCallback@Base 0.79 + linenoiseSetMultiLine@Base 0.79 + sb_alloc@Base 0.79 + sb_append@Base 0.79 + sb_append_len@Base 0.79 + sb_clear@Base 0.79 + sb_delete@Base 0.79 + sb_free@Base 0.79 + sb_insert@Base 0.79 + sb_realloc@Base 0.79 + sb_to_string@Base 0.79 + utf8_fromunicode@Base 0.72 diff -Nru jimtcl-0.79+dfsg0/debian/patches/0001-Disable-RPATH-support-in-Debian-builds.patch jimtcl-0.81+dfsg0/debian/patches/0001-Disable-RPATH-support-in-Debian-builds.patch --- jimtcl-0.79+dfsg0/debian/patches/0001-Disable-RPATH-support-in-Debian-builds.patch 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/patches/0001-Disable-RPATH-support-in-Debian-builds.patch 2022-05-28 07:35:15.000000000 +0000 @@ -0,0 +1,26 @@ +From: vimer +Date: Wed, 23 Mar 2022 20:21:59 +0800 +Subject: Disable-RPATH-support-in-Debian-builds + +--- + auto.def | 7 ++----- + 1 file changed, 2 insertions(+), 5 deletions(-) + +diff --git a/auto.def b/auto.def +index 5a66c7e..5935803 100644 +--- a/auto.def ++++ b/auto.def +@@ -445,11 +445,8 @@ if {[opt-bool shared with-jim-shared]} { + } + define VERSION [format %.2f [expr {[get-define JIM_VERSION] / 100.0}]] + define LIBSOEXT [format [get-define SH_SOEXTVER] [get-define VERSION]] +-if {[get-define libdir] ni {/lib /usr/lib}} { +- define SH_LINKRPATH_FLAGS [format [get-define SH_LINKRPATH] [get-define libdir]] +-} else { +- define SH_LINKRPATH_FLAGS "" +-} ++# Disable RPATH support in Debian builds ++define SH_LINKRPATH_FLAGS "" + define JIM_INSTALL [opt-bool install-jim] + define JIM_DOCS [opt-bool docs] + define JIM_RANDOMISE_HASH [opt-bool random-hash] diff -Nru jimtcl-0.79+dfsg0/debian/patches/0001-Use-footer-style-none-in-asciidoc-call.patch jimtcl-0.81+dfsg0/debian/patches/0001-Use-footer-style-none-in-asciidoc-call.patch --- jimtcl-0.79+dfsg0/debian/patches/0001-Use-footer-style-none-in-asciidoc-call.patch 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/patches/0001-Use-footer-style-none-in-asciidoc-call.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,22 +0,0 @@ -From: Didier Raboud -Date: Sun, 27 Aug 2017 17:19:03 +0200 -Subject: Use footer-style=none in asciidoc call - -In the asciidoc call, use the '-a footer-style=none' to export without the footer; as it contains the build timestamp, which makes the build unreproducible ---- - Makefile.in | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/Makefile.in b/Makefile.in -index 67d503c..270d42e 100644 ---- a/Makefile.in -+++ b/Makefile.in -@@ -177,7 +177,7 @@ install-docs: - - Tcl.html: jim_tcl.txt @srcdir@/make-index - @if HAVE_ASCIIDOC -- @tclsh@ @srcdir@/make-index $> $^ | @ASCIIDOC@ -d manpage - | @SED@ -e '/^/d' >$@ -+ @tclsh@ @srcdir@/make-index $> $^ | @ASCIIDOC@ -d manpage -a footer-style=none - | @SED@ -e '/^/d' >$@ - @else - @echo "asciidoc is not available"; false - @endif diff -Nru jimtcl-0.79+dfsg0/debian/patches/0002-Disable-RPATH-support-in-Debian-builds.patch jimtcl-0.81+dfsg0/debian/patches/0002-Disable-RPATH-support-in-Debian-builds.patch --- jimtcl-0.79+dfsg0/debian/patches/0002-Disable-RPATH-support-in-Debian-builds.patch 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/patches/0002-Disable-RPATH-support-in-Debian-builds.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -From: Didier Raboud -Date: Thu, 21 Nov 2019 10:37:32 +0100 -Subject: Disable RPATH support in Debian builds - ---- - auto.def | 7 ++----- - 1 file changed, 2 insertions(+), 5 deletions(-) - -diff --git a/auto.def b/auto.def -index fe6e4a2..3a3216b 100644 ---- a/auto.def -+++ b/auto.def -@@ -314,11 +314,8 @@ if {[opt-bool shared with-jim-shared]} { - } - define VERSION [format %.2f [expr {[get-define JIM_VERSION] / 100.0}]] - define LIBSOEXT [format [get-define SH_SOEXTVER] [get-define VERSION]] --if {[get-define libdir] ni {/lib /usr/lib}} { -- define SH_LINKRPATH_FLAGS [format [get-define SH_LINKRPATH] [get-define libdir]] --} else { -- define SH_LINKRPATH_FLAGS "" --} -+# Disable RPATH support in Debian builds -+define SH_LINKRPATH_FLAGS "" - define JIM_INSTALL [opt-bool install-jim] - define JIM_DOCS [opt-bool docs] - define JIM_RANDOMISE_HASH [opt-bool random-hash] diff -Nru jimtcl-0.79+dfsg0/debian/patches/series jimtcl-0.81+dfsg0/debian/patches/series --- jimtcl-0.79+dfsg0/debian/patches/series 2021-09-03 14:22:09.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/patches/series 2022-05-28 07:35:15.000000000 +0000 @@ -1,2 +1 @@ -0001-Use-footer-style-none-in-asciidoc-call.patch -0002-Disable-RPATH-support-in-Debian-builds.patch +0001-Disable-RPATH-support-in-Debian-builds.patch diff -Nru jimtcl-0.79+dfsg0/debian/watch jimtcl-0.81+dfsg0/debian/watch --- jimtcl-0.79+dfsg0/debian/watch 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/debian/watch 2022-05-28 07:35:15.000000000 +0000 @@ -0,0 +1,9 @@ + +version=4 +opts=\ +repacksuffix=+ds,\ +repack,compression=xz,\ +dversionmangle=s/\+(debian|dfsg|ds|deb)(\.?\d+)?$//,\ +filenamemangle=s%(?:.*?)?v?(\d[\d.]*)\.tar\.gz%-$1.tar.gz% \ +https://github.com/msteveb/jimtcl/tags \ +(?:.*?/)?v?(\d[\d.]*)\.tar\.gz debian uupdate diff -Nru jimtcl-0.79+dfsg0/DEVELOPING jimtcl-0.81+dfsg0/DEVELOPING --- jimtcl-0.79+dfsg0/DEVELOPING 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/DEVELOPING 2021-11-27 23:06:54.000000000 +0000 @@ -46,7 +46,7 @@ taken care of is the project mode -- it should be "push mode". Once the project is created one must add a user that will actually -start commiting new files to the repo. It can also be done through the +start committing new files to the repo. It can also be done through the WWW interface, so nothing more is necessary. Once finished with setting up a project on the WWW panel, one can @@ -65,12 +65,12 @@ In order to add file we type "git add ". For remove, we do "git rm ". To remove all local changes that aren't in a repository you do "git -reset --hard HEAD". Once inserted, files have to be commited with "git commit +reset --hard HEAD". Once inserted, files have to be committed with "git commit -a". Once done with commits for today, "git push" can be used to propagate changes from your local disk to the remote repository. Right now you can verify whether this works by trying to clone your -project's repository somewhere else, this time using anonymount HTTP +project's repository somewhere else, this time using anonymous HTTP access: git clone http://repo.or.cz/r/jimtcl/wkoszek.git @@ -83,7 +83,7 @@ http://jim.tcl.tk:8080/cgi-bin/mailman/listinfo/jim-devel -Patches prepared with the procedures presented abore are welcome. Before +Patches prepared with the procedures presented above are welcome. Before submitting patches, you can verify that your changes didn't bring any regressions to the Jim. In order to do so, sample regression tests have been implemented. You can execute them by typing: diff -Nru jimtcl-0.79+dfsg0/examples/certificate.pem jimtcl-0.81+dfsg0/examples/certificate.pem --- jimtcl-0.79+dfsg0/examples/certificate.pem 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/certificate.pem 2021-11-27 23:06:54.000000000 +0000 @@ -26,3 +26,54 @@ r9m5x0V15qZSvj1GWp6hSWIG/NwS+4gvv75Jlx83cr+bTlHgDl8h4seEmj8HhPq1 j9ZXBr9P2ETiD8OVyZAT3hhSwOg= -----END CERTIFICATE----- +-----BEGIN RSA PRIVATE KEY----- +MIIJKgIBAAKCAgEA0T9HMb5b2WZDIAF7+7KZzwAEiXC5misVrY1gmlwvLlSVx1pX +Kx5KrFpwkBMfDs1Zsi03/D46N+kViOmSJY/h5nxpiTdbs1Gld2b1RqFbnXcLmx7e +WVXXouLDcmzoJM1Y7vh26e9j3Uy4Bsew7zfxgnWmbfOA9Sg/rHamQFfJ+Ov9Nglk +AoGPwdIiDWc4+hkKD6HL3B72m3VyD4crDSuTm2vFqUDhXk+Jw3clNQYXHQrOSpDK +st1qPQtEDTQbrmKhSN6jMBRwcwfo39lCZLN02jEfOC2bwHPe+VgcyfCzWgfKHtPl +hqqanSIndDSAc6aF5hzI1vlT2dZNmSWDZ6QBrwharh25QXcnQhDr/9DyHIjgvojR +OsOiSaT4pVvJRBsVm7N/7kVQKvNdbwB8itz+ubLlb5SYahlZNBMpE9RqgchwAwe0 +SpjILMBHI90/H89SrZPZ4rMitZiIq5/3mBFEy/7Xio/G5jw/Gp3cHa6SMf/6cqhl +l7binB8s8Yd5c8RvdNunczCobKmbnTMDRdsnjnvWFmiaPJZUdcOtftxUCxYP2tEj +apQL8kjC+K4MjCGkde/5lrd8+yRY6GK6zixxfYb1jka/NFdXBaws4gm8amrsFstk +Y3K2GqrVh44/sG7BNqsl4hxkqyHryay7B413+KUrkiET4PqwSHgtJHPayAMCAwEA +AQKCAgEApOLjPCyP/jkaLg9dXtK3ZynRaWh9qSHIXFFqzVhVCYI34Last9qP508B +IlcfAzAIPWJqmoeCouo2QQQlWRoPXeut0iXgSebNp9Bm+ThPlD7p01u4xNbjLITa +lMGDEPUL3ovGUMOGgy1gWl9jaq4/zpjdBAl9FjKYMlPw4AUNr+xuRPWTbHIiEQ6A +LOWpPVMb3YOWvCdeFtSug9P0tdUf5LpBMQViUkoE+hVaKXVaI1WPh6yfPeFCRUYq +Yukr4vfvthdSqqGAlvSlqjdunSHYs9M/kapG8JmeHAg171+QRSKcQDyjwsGPQsFW +K7jve7K+Er2d+eDRFXhM/6BS8wmHFLP5BtHY/XCCZdjcJShIrGWK/Arepzh5TPpe +lIriZBzFBdtLNDaVs0Fj7C+r5ERYulgrF8gwEfPXxFen4vp4gjP3fRnApXgLfEGu +2Cj7SR62nZrRWKBuOYhaoVGt1zdoP7mmcL32/Kg78ItteaNXG07ICogXBoTl0Tj0 +N0wPpFG280amcJLB2tSwYyiIF53XyNazKxhgpBHnt1/y+peQfZadncQ/nImmM0f6 +GTql3ToEMKj9V3nrYUQhRVEmltCrfJA8pVjFJkp0AjlyZOf/FgcSFNvWbdn0t6vE +EOPU6RklpK0X0Go7B3ywOEqAu51oxo0QgUdRe6v2nzv7Xeuh9FkCggEBAPUV6JTg +uqjWxq7XNA3RljCy8NPzTsT7AS7XwLBD/+JcICXjQQ2SVqMzx7SftGucGw6/8GKx +HRXwp67k73iifiiQ7f1xOsXXgVs7aDg1MT7UE9KOVuY0r74P3No13nSfNYzOMBjh +a+FqKO5v8yjZjNwT5ghtHluJqXPQPMeKYzR3ngNlFRzW9cfDQspiHdTSpu9gFE02 +iSug9SNxMjRDiWsqBC14qu3S3ynaU5UuKhqw5CVSRj/Y7pN94b01tVXe4Szcf/U0 +HXzg33jlf1QshwsdcBXcGpkB5ijtp6koQuAKRHjxeqcpMKIPpxzratlWBPeynvX7 +xO+bDultW4z8tr0CggEBANqQy30ZMM64v39bo04cQNrIMJd2ez1c/lqysneQwIuK +1ALfRJbN74/Zy+vlx9VH6tKT2i5o1FP1Nd5BKiRGLd3bTLE+UlweUWrZoJbyz7ns +IuLqGhw9Qy9SaqCfSyGu9Lmn8blCMVDPf1AggB4fuFHhiT+aBK1AidzDM/Usar2H +D2HwfWP3tKARcyzBnWExiDncUau8oRFdfsYL72kb2P3RvtDtsMRLSFHOdd88o1Us +LSQ+T36U3A2UKCteBndBguN+N7zyUNk7DVpfXILKmFj9nDmoYOFsnctG+TYbRmfr +7G/wKDcEtrmK0tpSOLF5QvowO3qDYaYYYGdK5EPbxb8CggEACDRtjt5fIVvfVucZ +dQT5NDQpX88bafjFN149syjzng5bfSk4ek3V3KzVGLToA1o8hafjUkp/oMZntrEv +WyiFdLI1ZXCu+QSX7gf1Gzyco2/SIhBl1FsbLw+04xE+m0ThNA+LCKozRF6bdDAH +QezWjF+WKd4NUB8xrxDfmAaH/6+peI+fv1Fq9P8Sc1gJi6BpukXLKDKVMQK4cjFN +7vX72byUWzlY75FJq0sF1U6wVihp2t4AQA7xHbrvHbh4k6FchHX1Sq4t9opIsPFt +69F5y+N2ZyTxNwIbRG+AV2djpcByPmJHKuV0HVjMzWkMMK5yiCBQtgdxtlvIigQB +Np0XOQKCAQEAw6yYEUJpONmbz/iJppeS1IwfPKq9QL2tliOftX2pdARxNLUQYfay +v9WcRHBuTJrbN3VZAu2lEhlZBcbPZLRTwejgq1oBQCmAeKmnpRxzLp+iyAYQJDIQ +oSAnB/A0wk4xGLmrplEFd7Sc5W6DZPS+/sdtKbzI7Rb3leZI8Pm4AkAVXHiCuen9 +EsUsmOgp7ub6b9q4X4k7piFPKx1qVG6zAOIz9DaoZ8SCVYMCcj6Gd+1Z6LXEU64P +qDR5FgJSxZeoB+VrH0TNbv34QW1YlFuusxUyNUhym76zMlczK+aVTNqhzcFzL3aP +5GLNzNmJmhHXDcf6p/9Rf/MY88DPxZTPXwKCAQEAt2cxXMiEWfFwWHufqpahl3Aq +C4yf0EFMhBsOmnDYZ4RDYikFGJog7XY+BOEX0NZ2z2ZghwjmQW/Gm14ISQnww97d +uo/MDuUZvf6aAeh6gRmkiejhIXMwuvxRAwm90TFUiJ4yn8LKp2c1XxX8DMHujlzS +cdUKcFO3OL+eLQazM5M+3qxQuAFDTlBf41d3OJjCOuQ9soBy0Gy9yMhtjFVVmKDw +eArA0lZgskLVcI9JH6bPhv7+5+n26OqMlFjtmbNMwqi/lOoyGwst5b2d9oAMkWQi +QW5pi51MaAwVV8q8NdfUv1twD8lpRV8Rwb2k8rmG5FqSwhOsibSwpu8gf4WYow== +-----END RSA PRIVATE KEY----- diff -Nru jimtcl-0.79+dfsg0/examples/COPYING.FreeSans.ttf jimtcl-0.81+dfsg0/examples/COPYING.FreeSans.ttf --- jimtcl-0.79+dfsg0/examples/COPYING.FreeSans.ttf 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/COPYING.FreeSans.ttf 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff -Nru jimtcl-0.79+dfsg0/examples/dbgtest.tcl jimtcl-0.81+dfsg0/examples/dbgtest.tcl --- jimtcl-0.79+dfsg0/examples/dbgtest.tcl 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/dbgtest.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,34 @@ +# An example script useful for testing the Jim debugger +# Taken from http://www.nist.gov/msidlibrary/doc/libes93c.ps + +set b 1 + +proc p4 {x} { + return [ + expr 5+[expr 1+$x]] +} + +set z [ + expr 1+[expr 2+[p4 $b]] +] + +proc p3 {} { + set m 0 +} + +proc p2 {} { + set c 4 + p3 + set d 5 +} + +proc p1 {} { + set a 2 + p2 + set a 3 + set a 5 +} + +p1 +set k 7 +p1 Binary files /tmp/tmpwu5ip3ii/JDuxYloNrZ/jimtcl-0.79+dfsg0/examples/FreeSans.ttf and /tmp/tmpwu5ip3ii/Cgt8qGBxtF/jimtcl-0.81+dfsg0/examples/FreeSans.ttf differ diff -Nru jimtcl-0.79+dfsg0/examples/jcov jimtcl-0.81+dfsg0/examples/jcov --- jimtcl-0.79+dfsg0/examples/jcov 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/jcov 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,66 @@ +#!/usr/bin/env jimsh +# vim:se syntax=tcl: + +# Experimental code coverage for Jim Tcl + +set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib] + +set opt_all 0 +if {[lindex $argv 0] eq "-all"} { + incr opt_all + set argv [lrange $argv 1 end] +} + +set argv [lassign $argv argv0] + +set coverage($argv0) {} + +proc xcov {type file line result name arglist} { + upvar ::coverage($file) info + incr info($line) +} + +xtrace xcov + +# Catch exit but not error +set rc [catch -noerror -exit {source $argv0} msg opts] + +xtrace {} + +proc show-coverage {filename} { + set info $::coverage($filename) + + puts "=== $filename ===" + set f [open $filename] + set n 0 + while {[$f gets buf] >= 0} { + incr n + if {[info exists info($n)]} { + set prefix [format "%4d: " $info($n)] + } else { + set b [string trimleft $buf] + if {$b eq "" || [string match "#*" $b] || [string match "\}*" $b]} { + set prefix " -: " + } else { + set prefix "####: " + } + } + puts "$prefix$buf" + } + $f close +} + +puts [dict keys $coverage] +if {$opt_all} { + foreach filename [lsort [dict keys $coverage]] { + if {$filename in {"" jcov}} { + continue + } + show-coverage $filename + puts "" + } +} else { + show-coverage $argv0 +} + +#parray coverage diff -Nru jimtcl-0.79+dfsg0/examples/jtime jimtcl-0.81+dfsg0/examples/jtime --- jimtcl-0.79+dfsg0/examples/jtime 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/jtime 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,53 @@ +#!/usr/bin/env jimsh +# vim:se syntax=tcl: + +# Experimental code coverage for Jim Tcl + +set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib] + +set argv [lassign $argv argv0] + +set jtime::fileinfo($argv0) {} +set jtime::last [clock micros] + +proc jtime::xtrace {type file line result name arglist} { + variable fileinfo + variable last + set now [clock micros] + + if {![exists fileinfo($file)]} { + set info {} + } else { + set info $fileinfo($file) + } + incr info($line) $($now - $last) + set fileinfo($file) $info + + set last $now +} + +xtrace jtime::xtrace + +# Catch exit but not error +set rc [catch -noerror -exit {source $argv0} msg opts] + +xtrace {} + +set info $jtime::fileinfo($argv0) + +set f [open $argv0] +set n 0 +while {[$f gets buf] >= 0} { + incr n + if {[info exists info($n)]} { + set prefix [format "%8d: " $info($n)] + } else { + set b [string trimleft $buf] + if {$b eq "" || [string match "#*" $b] || [string match "\}*" $b]} { + set prefix " -: " + } else { + set prefix " ####: " + } + } + puts "$prefix$buf" +} diff -Nru jimtcl-0.79+dfsg0/examples/jtrace jimtcl-0.81+dfsg0/examples/jtrace --- jimtcl-0.79+dfsg0/examples/jtrace 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/jtrace 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,23 @@ +#!/usr/bin/env jimsh +# vim:se syntax=tcl: + +# Experimental code coverage for Jim Tcl + +set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib] + +set argv [lassign $argv argv0] + +proc jtime::xtrace {type file line result name arglist} { + set indent [string repeat " " [info level]] + if {[string length $arglist] > 45} { + set arglist [string range $arglist 0 45]... + } + stderr puts "$indent$name [string map {\r \\r \n \\n} $arglist]" +} + +xtrace jtime::xtrace + +# Catch exit but not error +set rc [catch -noerror -exit {source $argv0} msg opts] + +xtrace {} diff -Nru jimtcl-0.79+dfsg0/examples/key.pem jimtcl-0.81+dfsg0/examples/key.pem --- jimtcl-0.79+dfsg0/examples/key.pem 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/key.pem 1970-01-01 00:00:00.000000000 +0000 @@ -1,51 +0,0 @@ ------BEGIN RSA PRIVATE KEY----- -MIIJKgIBAAKCAgEA0T9HMb5b2WZDIAF7+7KZzwAEiXC5misVrY1gmlwvLlSVx1pX -Kx5KrFpwkBMfDs1Zsi03/D46N+kViOmSJY/h5nxpiTdbs1Gld2b1RqFbnXcLmx7e -WVXXouLDcmzoJM1Y7vh26e9j3Uy4Bsew7zfxgnWmbfOA9Sg/rHamQFfJ+Ov9Nglk -AoGPwdIiDWc4+hkKD6HL3B72m3VyD4crDSuTm2vFqUDhXk+Jw3clNQYXHQrOSpDK -st1qPQtEDTQbrmKhSN6jMBRwcwfo39lCZLN02jEfOC2bwHPe+VgcyfCzWgfKHtPl -hqqanSIndDSAc6aF5hzI1vlT2dZNmSWDZ6QBrwharh25QXcnQhDr/9DyHIjgvojR -OsOiSaT4pVvJRBsVm7N/7kVQKvNdbwB8itz+ubLlb5SYahlZNBMpE9RqgchwAwe0 -SpjILMBHI90/H89SrZPZ4rMitZiIq5/3mBFEy/7Xio/G5jw/Gp3cHa6SMf/6cqhl -l7binB8s8Yd5c8RvdNunczCobKmbnTMDRdsnjnvWFmiaPJZUdcOtftxUCxYP2tEj -apQL8kjC+K4MjCGkde/5lrd8+yRY6GK6zixxfYb1jka/NFdXBaws4gm8amrsFstk -Y3K2GqrVh44/sG7BNqsl4hxkqyHryay7B413+KUrkiET4PqwSHgtJHPayAMCAwEA -AQKCAgEApOLjPCyP/jkaLg9dXtK3ZynRaWh9qSHIXFFqzVhVCYI34Last9qP508B -IlcfAzAIPWJqmoeCouo2QQQlWRoPXeut0iXgSebNp9Bm+ThPlD7p01u4xNbjLITa -lMGDEPUL3ovGUMOGgy1gWl9jaq4/zpjdBAl9FjKYMlPw4AUNr+xuRPWTbHIiEQ6A -LOWpPVMb3YOWvCdeFtSug9P0tdUf5LpBMQViUkoE+hVaKXVaI1WPh6yfPeFCRUYq -Yukr4vfvthdSqqGAlvSlqjdunSHYs9M/kapG8JmeHAg171+QRSKcQDyjwsGPQsFW -K7jve7K+Er2d+eDRFXhM/6BS8wmHFLP5BtHY/XCCZdjcJShIrGWK/Arepzh5TPpe -lIriZBzFBdtLNDaVs0Fj7C+r5ERYulgrF8gwEfPXxFen4vp4gjP3fRnApXgLfEGu -2Cj7SR62nZrRWKBuOYhaoVGt1zdoP7mmcL32/Kg78ItteaNXG07ICogXBoTl0Tj0 -N0wPpFG280amcJLB2tSwYyiIF53XyNazKxhgpBHnt1/y+peQfZadncQ/nImmM0f6 -GTql3ToEMKj9V3nrYUQhRVEmltCrfJA8pVjFJkp0AjlyZOf/FgcSFNvWbdn0t6vE -EOPU6RklpK0X0Go7B3ywOEqAu51oxo0QgUdRe6v2nzv7Xeuh9FkCggEBAPUV6JTg -uqjWxq7XNA3RljCy8NPzTsT7AS7XwLBD/+JcICXjQQ2SVqMzx7SftGucGw6/8GKx -HRXwp67k73iifiiQ7f1xOsXXgVs7aDg1MT7UE9KOVuY0r74P3No13nSfNYzOMBjh -a+FqKO5v8yjZjNwT5ghtHluJqXPQPMeKYzR3ngNlFRzW9cfDQspiHdTSpu9gFE02 -iSug9SNxMjRDiWsqBC14qu3S3ynaU5UuKhqw5CVSRj/Y7pN94b01tVXe4Szcf/U0 -HXzg33jlf1QshwsdcBXcGpkB5ijtp6koQuAKRHjxeqcpMKIPpxzratlWBPeynvX7 -xO+bDultW4z8tr0CggEBANqQy30ZMM64v39bo04cQNrIMJd2ez1c/lqysneQwIuK -1ALfRJbN74/Zy+vlx9VH6tKT2i5o1FP1Nd5BKiRGLd3bTLE+UlweUWrZoJbyz7ns -IuLqGhw9Qy9SaqCfSyGu9Lmn8blCMVDPf1AggB4fuFHhiT+aBK1AidzDM/Usar2H -D2HwfWP3tKARcyzBnWExiDncUau8oRFdfsYL72kb2P3RvtDtsMRLSFHOdd88o1Us -LSQ+T36U3A2UKCteBndBguN+N7zyUNk7DVpfXILKmFj9nDmoYOFsnctG+TYbRmfr -7G/wKDcEtrmK0tpSOLF5QvowO3qDYaYYYGdK5EPbxb8CggEACDRtjt5fIVvfVucZ -dQT5NDQpX88bafjFN149syjzng5bfSk4ek3V3KzVGLToA1o8hafjUkp/oMZntrEv -WyiFdLI1ZXCu+QSX7gf1Gzyco2/SIhBl1FsbLw+04xE+m0ThNA+LCKozRF6bdDAH -QezWjF+WKd4NUB8xrxDfmAaH/6+peI+fv1Fq9P8Sc1gJi6BpukXLKDKVMQK4cjFN -7vX72byUWzlY75FJq0sF1U6wVihp2t4AQA7xHbrvHbh4k6FchHX1Sq4t9opIsPFt -69F5y+N2ZyTxNwIbRG+AV2djpcByPmJHKuV0HVjMzWkMMK5yiCBQtgdxtlvIigQB -Np0XOQKCAQEAw6yYEUJpONmbz/iJppeS1IwfPKq9QL2tliOftX2pdARxNLUQYfay -v9WcRHBuTJrbN3VZAu2lEhlZBcbPZLRTwejgq1oBQCmAeKmnpRxzLp+iyAYQJDIQ -oSAnB/A0wk4xGLmrplEFd7Sc5W6DZPS+/sdtKbzI7Rb3leZI8Pm4AkAVXHiCuen9 -EsUsmOgp7ub6b9q4X4k7piFPKx1qVG6zAOIz9DaoZ8SCVYMCcj6Gd+1Z6LXEU64P -qDR5FgJSxZeoB+VrH0TNbv34QW1YlFuusxUyNUhym76zMlczK+aVTNqhzcFzL3aP -5GLNzNmJmhHXDcf6p/9Rf/MY88DPxZTPXwKCAQEAt2cxXMiEWfFwWHufqpahl3Aq -C4yf0EFMhBsOmnDYZ4RDYikFGJog7XY+BOEX0NZ2z2ZghwjmQW/Gm14ISQnww97d -uo/MDuUZvf6aAeh6gRmkiejhIXMwuvxRAwm90TFUiJ4yn8LKp2c1XxX8DMHujlzS -cdUKcFO3OL+eLQazM5M+3qxQuAFDTlBf41d3OJjCOuQ9soBy0Gy9yMhtjFVVmKDw -eArA0lZgskLVcI9JH6bPhv7+5+n26OqMlFjtmbNMwqi/lOoyGwst5b2d9oAMkWQi -QW5pi51MaAwVV8q8NdfUv1twD8lpRV8Rwb2k8rmG5FqSwhOsibSwpu8gf4WYow== ------END RSA PRIVATE KEY----- diff -Nru jimtcl-0.79+dfsg0/examples/redis-pubsub.tcl jimtcl-0.81+dfsg0/examples/redis-pubsub.tcl --- jimtcl-0.79+dfsg0/examples/redis-pubsub.tcl 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/redis-pubsub.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,61 @@ +#!/usr/bin/env jimsh + +# Requires the redis extension +package require redis + +# A redis server should be running either on localhost 6379 +# or on the given host port +# +# Usage: redis-pubsub.tcl ?pub|sub? ?host:addr? +# +# If pub or sub is not given, forks and does both + +if {[lindex $argv 0] in {pub sub}} { + # Run in single process mode + set argv [lassign $argv op] +} else { + # fork before connecting so that both processes don't share + # a connection + if {[os.fork] == 0} { + # child subscribes + set op sub + } else { + set op pub + } +} + +try { + lassign $argv addr + if {$addr eq ""} { + set addr localhost:6379 + } + set r [redis [socket stream $addr]] +} on error msg { + puts [errorInfo $msg] + exit 1 +} + +if {$op eq "sub"} { + $r SUBSCRIBE chin + $r SUBSCRIBE chan + + $r readable { + after cancel $afterid + set result [$r read] + puts "$op: $result" + set afterid [after 2000 {incr done}] + } + # If no message for 2 seconds, stop + set afterid [after 2000 {incr done}] + vwait done + puts "$op: quitting on idle" +} else { + loop i 1 15 { + $r PUBLISH chan PONG$i + puts "$op: chan PONG$i" + after 250 + $r PUBLISH chin PING$i + puts "$op: chin PING$i" + after 250 + } +} diff -Nru jimtcl-0.79+dfsg0/examples/redis.tcl jimtcl-0.81+dfsg0/examples/redis.tcl --- jimtcl-0.79+dfsg0/examples/redis.tcl 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/redis.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,54 @@ +#!/usr/bin/env jimsh + +# A simple test of the redis extension + +# Requires the redis extension +package require redis + +# A redis server should be running either on localhost 6379 +# or on the given address (e.g. host:port) +try { + lassign $argv addr + if {$addr eq ""} { + set addr localhost:6379 + } + set r [redis [socket stream $addr]] +} on error msg { + puts [errorInfo $msg] + exit 1 +} + +puts "KEYS: [$r KEYS *]" + +# Set a hash +set env(testing) yes +$r HMSET env {*}$env + +set result [$r HGET env testing] +puts "HGET: testing=$result" + +set size [$r HLEN env] +puts "Size of env is $size" + +set time [time { + $r HGETALL env +} 100] +puts "HGETALL: $time" + +# a multi-command transation +$r MULTI +$r SET a A1 +$r SET b B2 +$r EXEC +puts "MGET: [$r MGET a b]" + +# disard +$r MULTI +$r SET a ~A1 +$r SET b ~B2 +$r DISCARD +puts "MGET (DISCARD): [$r MGET a b]" + +set result [$r HGET env testing] + +$r close diff -Nru jimtcl-0.79+dfsg0/examples/sdlcircles.tcl jimtcl-0.81+dfsg0/examples/sdlcircles.tcl --- jimtcl-0.79+dfsg0/examples/sdlcircles.tcl 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/sdlcircles.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,28 @@ +package require sdl + +set xres 1024 +set yres 768 +set s [sdl.screen $xres $yres "Jim SDL Circles"] + +proc drawlist {s list} { + foreach item $list { + $s {*}$item + } +} + +proc rand_circle {xres yres maxradius alpha} { + list fcircle [rand $xres] [rand $yres] [rand $maxradius] [rand 256] [rand 256] [rand 256] $alpha +} + +loop i 0 200 { + set commands {} + loop j 0 1000 { + lappend commands [rand_circle $xres $yres 40 100] + if {$j % 50 == 0} { + #$s clear 200 200 200 + drawlist $s $commands + $s flip + sleep 0.1 + } + } +} diff -Nru jimtcl-0.79+dfsg0/examples/sdlevents.tcl jimtcl-0.81+dfsg0/examples/sdlevents.tcl --- jimtcl-0.79+dfsg0/examples/sdlevents.tcl 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/sdlevents.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,96 @@ +package require sdl +package require oo + +set xres 640 +set yres 384 +set s [sdl.screen $xres $yres "Jim Tcl - SDL, Eventloop integration"] + +set col(cyan) {0 255 255} +set col(yellow) {255 255 0} +set col(red) {255 0 0} +set col(green) {0 255 0} +set col(white) {255 255 255} +set col(blue) {0 0 255} +set ncols [dict size $col] + +set grey {50 50 50} + +class ball { + name - + pos {x 256 y 256} + color {255 255 255} + res {x 512 y 512} + delta {x 3 y 3} + radius 40 + havetext 1 +} + +ball method draw {s} { + $s fcircle $pos(x) $pos(y) $radius {*}$color + if {$havetext} { + $s text "($pos(x),$pos(y))" $pos(x)-25 $pos(y)-5 0 0 0 + } + foreach xy {x y} { + incr pos($xy) $delta($xy) + if {$pos($xy) <= $radius + $delta($xy) || $pos($xy) >= $res($xy) - $radius - $delta($xy) || [rand 50] == 1} { + set delta($xy) $(-1 * $delta($xy)) + incr pos($xy) $(2 * $delta($xy)) + } + } +} + +ball method setvar {name_ value_} { + set $name_ $value_ +} + +try { + $s font [file dirname [info script]]/FreeSans.ttf 12 + set havetext 1 +} on error msg { + puts $msg + set havetext 0 +} + +foreach c [dict keys $col] { + set b [ball] + $b setvar name $c + $b setvar res(x) $xres + $b setvar res(y) $yres + $b setvar pos(x) $($xres/2) + $b setvar pos(y) $($yres/2) + $b setvar color [list {*}$col($c) 150] + $b setvar havetext $havetext + lappend balls $b +} + +proc draw {balls} {s} { + $s clear {*}$::grey + foreach ball $balls { + $ball draw $s + } + $s flip +} + +# Example of integrating the Tcl event loop with SDL +# We need to always be polling SDL, and also run the Tcl event loop + +# The Tcl event loop runs from within the SDL poll loop via +# a (non-blocking) call to update +proc heartbeat {} { + puts $([clock millis] % 1000000) + after 250 heartbeat +} + +set t1 [clock millis] +draw $balls +heartbeat +$s poll { + draw $balls + update + set t2 [clock millis] + # 33ms = 30 frames/second + if {$t2 - $t1 < 33} { + after $(33 - ($t2 - $t1)) + } + set t1 $t2 +} diff -Nru jimtcl-0.79+dfsg0/examples/sdltest.tcl jimtcl-0.81+dfsg0/examples/sdltest.tcl --- jimtcl-0.79+dfsg0/examples/sdltest.tcl 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/sdltest.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,65 @@ +package require sdl + +# Basic test of all sdl commands + +set xres 640 +set yres 384 +set s [sdl.screen $xres $yres [info script]] + +set cyan {0 255 255} +set yellow {255 255 0} +set red {255 0 0} +set green {0 255 0} +set grey {20 20 20} +set white {255 255 255} +set blue {0 0 255} + +$s clear {*}$grey + +$s fcircle 320 280 40 {*}$cyan 150 +$s circle 320 280 60 {*}$yellow +$s aacircle 320 280 80 {*}$green + +$s rectangle 200 100 300 180 {*}$cyan +$s box 210 110 290 170 {*}$yellow 150 + +set x 20 +set y 20 +set dy 10 +set dx 10 +foreach i [range 50] { + set nx $($x + $dx) + set ny $($y + $dy) + $s line $x $y $nx $ny {*}$green + $s aaline $x $($y+30) $nx $($ny+30) {*}$red + set x $nx + set y $ny + set dy $(-$dy) +} + +$s rectangle 50 150 150 250 {*}$yellow +foreach i [range 500] { + $s pixel $([rand 100] + 50) $([rand 100] + 150) {*}$white +} + +if {[llength $argv]} { + lassign $argv font +} else { + set font [file join [file dirname [info script]] FreeSans.ttf] +} + +try { + $s font $font 18 + $s text "[file tail $font] 16pt" 20 270 {*}$yellow + $s font $font 14 + $s text "[file tail $font] 12pt" 20 300 {*}$green 150 + # Note that depending on the font, certain unicode glyphs + # may or may not be rendered. + # Also, need to build with --utf8 + $s text "utf-8: \u00bb \u273b \u261e" 20 330 {*}$cyan +} on error msg { + puts $msg +} + +$s poll { sleep 0.25 } +$s free diff -Nru jimtcl-0.79+dfsg0/examples/ssl.server jimtcl-0.81+dfsg0/examples/ssl.server --- jimtcl-0.79+dfsg0/examples/ssl.server 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples/ssl.server 2021-11-27 23:06:54.000000000 +0000 @@ -6,7 +6,7 @@ $s readable { # Clean up children wait -nohang 0 - set sock [[$s accept addr] ssl -server certificate.pem key.pem] + set sock [[$s accept addr] ssl -server certificate.pem] puts "Client address: $addr" # Make this server forking so we can accept multiple diff -Nru jimtcl-0.79+dfsg0/examples.api/Makefile jimtcl-0.81+dfsg0/examples.api/Makefile --- jimtcl-0.79+dfsg0/examples.api/Makefile 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples.api/Makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -CFLAGS+= -Wall -g -CFLAGS+= -I.. -LDLIBS += -L.. -ljim - -EXAMPLES= \ - jim_command \ - jim_hello \ - jim_list \ - jim_obj \ - jim_return - -all: $(EXAMPLES) - -clean: - rm -rf $(EXAMPLES) - rm -rf *.core diff -Nru jimtcl-0.79+dfsg0/examples.api/Makefile.in jimtcl-0.81+dfsg0/examples.api/Makefile.in --- jimtcl-0.79+dfsg0/examples.api/Makefile.in 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/examples.api/Makefile.in 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,17 @@ +CFLAGS+= -Wall -g +CFLAGS+= -I.. +LDFLAGS += @LDFLAGS@ +LDLIBS += -L.. -ljim @LDLIBS@ + +EXAMPLES= \ + jim_command \ + jim_hello \ + jim_list \ + jim_obj \ + jim_return + +all: $(EXAMPLES) + +clean: + rm -rf $(EXAMPLES) + rm -rf *.core diff -Nru jimtcl-0.79+dfsg0/.gitignore jimtcl-0.81+dfsg0/.gitignore --- jimtcl-0.79+dfsg0/.gitignore 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/.gitignore 2021-11-27 23:06:54.000000000 +0000 @@ -1,6 +1,8 @@ config.log tags /Makefile +/examples.api/Makefile +/tests/Makefile Tcl.html jimautoconf.h jimautoconfext.h @@ -19,3 +21,8 @@ configure.gnu jimsh0 build-jim-ext +*.gcda +*.gcno +*.gcov +coverage*.html +jimtcl.pc diff -Nru jimtcl-0.79+dfsg0/jim-aio.c jimtcl-0.81+dfsg0/jim-aio.c --- jimtcl-0.79+dfsg0/jim-aio.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-aio.c 2021-11-27 23:06:54.000000000 +0000 @@ -51,6 +51,12 @@ #include #include #endif +#ifdef HAVE_UTIL_H +#include +#endif +#ifdef HAVE_PTY_H +#include +#endif #include "jim.h" #include "jimiocompat.h" @@ -95,6 +101,7 @@ #define AIO_KEEPOPEN 1 #define AIO_NODELETE 2 +#define AIO_EOF 4 #if defined(JIM_IPV6) #define IPV6 1 @@ -150,6 +157,8 @@ int (*error)(const struct AioFile *af); const char *(*strerror)(struct AioFile *af); int (*verify)(struct AioFile *af); + int (*eof)(struct AioFile *af); + int (*pending)(struct AioFile *af); } JimAioFopsType; typedef struct AioFile @@ -157,11 +166,8 @@ FILE *fp; Jim_Obj *filename; int type; - int openFlags; /* AIO_KEEPOPEN? keep FILE* */ + int flags; /* AIO_KEEPOPEN? keep FILE* */ int fd; - Jim_Obj *rEvent; - Jim_Obj *wEvent; - Jim_Obj *eEvent; int addr_family; void *ssl; const JimAioFopsType *fops; @@ -210,13 +216,20 @@ return strerror(errno); } +static int stdio_eof(struct AioFile *af) +{ + return feof(af->fp); +} + static const JimAioFopsType stdio_fops = { stdio_writer, stdio_reader, stdio_getline, stdio_error, stdio_strerror, - NULL + NULL, /* verify */ + stdio_eof, + NULL, /* pending */ }; #if defined(JIM_SSL) && !defined(JIM_BOOTSTRAP) @@ -228,35 +241,68 @@ return SSL_write(af->ssl, buf, len); } +static int ssl_pending(struct AioFile *af) +{ + return SSL_pending(af->ssl); +} + static int ssl_reader(struct AioFile *af, char *buf, int len) { - return SSL_read(af->ssl, buf, len); + int ret = SSL_read(af->ssl, buf, len); + switch (SSL_get_error(af->ssl, ret)) { + case SSL_ERROR_NONE: + return ret; + case SSL_ERROR_SYSCALL: + case SSL_ERROR_ZERO_RETURN: + if (errno != EAGAIN) { + af->flags |= AIO_EOF; + } + return 0; + case SSL_ERROR_SSL: + default: + if (errno == EAGAIN) { + return 0; + } + af->flags |= AIO_EOF; + return -1; + } +} + +static int ssl_eof(struct AioFile *af) +{ + return (af->flags & AIO_EOF); } static const char *ssl_getline(struct AioFile *af, char *buf, int len) { size_t i; - for (i = 0; i < len + 1; i++) { - if (SSL_read(af->ssl, &buf[i], 1) != 1) { - if (i == 0) { - return NULL; - } + for (i = 0; i < len - 1 && !ssl_eof(af); i++) { + int ret = ssl_reader(af, &buf[i], 1); + if (ret != 1) { break; } if (buf[i] == '\n') { + i++; break; } } buf[i] = '\0'; + if (i == 0 && ssl_eof(af)) { + return NULL; + } return buf; } static int ssl_error(const struct AioFile *af) { - if (ERR_peek_error() == 0) { - return JIM_OK; + int ret = SSL_get_error(af->ssl, 0); + /* XXX should we be following the same logic as ssl_reader() here? */ + if (ret == SSL_ERROR_ZERO_RETURN || ret == SSL_ERROR_NONE) { + return JIM_OK; + } + if (ret == SSL_ERROR_SYSCALL) { + return stdio_error(af); } - return JIM_ERR; } @@ -295,7 +341,9 @@ ssl_getline, ssl_error, ssl_strerror, - ssl_verify + ssl_verify, + ssl_eof, + ssl_pending, }; #endif /* JIM_BOOTSTRAP */ @@ -367,7 +415,7 @@ } #endif -static int JimParseIPv6Address(Jim_Interp *interp, const char *hostport, union sockaddr_any *sa, socklen_t *salen) +static int JimParseIPv6Address(Jim_Interp *interp, int socktype, const char *hostport, union sockaddr_any *sa, socklen_t *salen) { #if IPV6 /* @@ -411,9 +459,10 @@ memset(&req, '\0', sizeof(req)); req.ai_family = PF_INET6; + req.ai_socktype = socktype; if (getaddrinfo(sthost, stport, &req, &ai)) { - Jim_SetResultFormatted(interp, "Not a valid address: %s", hostport); + Jim_SetResultFormatted(interp, "Not a valid address: %s:%s", sthost, stport); ret = JIM_ERR; } else { @@ -430,7 +479,7 @@ #endif } -static int JimParseIpAddress(Jim_Interp *interp, const char *hostport, union sockaddr_any *sa, socklen_t *salen) +static int JimParseIpAddress(Jim_Interp *interp, int socktype, const char *hostport, union sockaddr_any *sa, socklen_t *salen) { /* An IPv4 addr/port looks like: * 192.168.1.5 @@ -459,6 +508,7 @@ memset(&req, '\0', sizeof(req)); req.ai_family = PF_INET; + req.ai_socktype = socktype; if (getaddrinfo(sthost, stport, &req, &ai)) { ret = JIM_ERR; @@ -488,7 +538,7 @@ } #endif -static int JimParseSocketAddress(Jim_Interp *interp, int family, const char *addr, union sockaddr_any *sa, socklen_t *salen) +static int JimParseSocketAddress(Jim_Interp *interp, int family, int socktype, const char *addr, union sockaddr_any *sa, socklen_t *salen) { switch (family) { #if UNIX_SOCKETS @@ -496,9 +546,9 @@ return JimParseDomainAddress(interp, addr, sa, salen); #endif case PF_INET6: - return JimParseIPv6Address(interp, addr, sa, salen); + return JimParseIPv6Address(interp, socktype, addr, sa, salen); case PF_INET: - return JimParseIpAddress(interp, addr, sa, salen); + return JimParseIpAddress(interp, socktype, addr, sa, salen); } return JIM_ERR; } @@ -541,7 +591,6 @@ default: /* Otherwise just an empty address */ addr = ""; - fprintf(stderr, "%s:%d", __FILE__, __LINE__); break; } @@ -606,7 +655,7 @@ JIM_NOTUSED(interp); #if UNIX_SOCKETS - if (af->addr_family == PF_UNIX && (af->openFlags & AIO_NODELETE) == 0) { + if (af->addr_family == PF_UNIX && (af->flags & AIO_NODELETE) == 0) { /* If this is bound, delete the socket file now */ Jim_Obj *filenameObj = aio_sockname(interp, af); if (filenameObj) { @@ -630,7 +679,7 @@ SSL_free(af->ssl); } #endif - if (!(af->openFlags & AIO_KEEPOPEN)) { + if (!(af->flags & AIO_KEEPOPEN)) { fclose(af->fp); } @@ -643,22 +692,42 @@ char buf[AIO_BUF_LEN]; Jim_Obj *objPtr; int nonewline = 0; + int pending = 0; jim_wide neededLen = -1; /* -1 is "read as much as possible" */ + static const char * const options[] = { "-pending", "-nonewline", NULL }; + enum { OPT_PENDING, OPT_NONEWLINE }; + int option; - if (argc && Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) { - nonewline = 1; - argv++; - argc--; - } - if (argc == 1) { - if (Jim_GetWide(interp, argv[0], &neededLen) != JIM_OK) - return JIM_ERR; - if (neededLen < 0) { - Jim_SetResultString(interp, "invalid parameter: negative len", -1); - return JIM_ERR; + if (argc) { + if (*Jim_String(argv[0]) == '-') { + if (Jim_GetEnum(interp, argv[0], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_PENDING: + if (!af->fops->pending) { + Jim_SetResultString(interp, "-pending not supported on this connection type", -1); + return JIM_ERR; + } + pending++; + break; + case OPT_NONEWLINE: + nonewline++; + break; + } } + else { + if (Jim_GetWide(interp, argv[0], &neededLen) != JIM_OK) + return JIM_ERR; + if (neededLen < 0) { + Jim_SetResultString(interp, "invalid parameter: negative len", -1); + return JIM_ERR; + } + } + argc--; + argv++; } - else if (argc) { + if (argc) { return -1; } objPtr = Jim_NewStringObj(interp, NULL, 0); @@ -672,15 +741,22 @@ else { readlen = (neededLen > AIO_BUF_LEN ? AIO_BUF_LEN : neededLen); } - retval = af->fops->reader(af, buf, readlen); + retval = af->fops->reader(af, buf, pending ? 1 : readlen); if (retval > 0) { Jim_AppendString(interp, objPtr, buf, retval); if (neededLen != -1) { neededLen -= retval; } + else if (pending) { + /* If pending was specified, after we do the initial read, + * we do a second read to fetch any buffered data + */ + neededLen = af->fops->pending(af); + } } - if (retval != readlen) + if (retval <= 0) { break; + } } /* Check for error conditions */ if (JimCheckStreamError(interp, af)) { @@ -824,7 +900,7 @@ len = Jim_Length(objPtr); - if (len == 0 && feof(af->fp)) { + if (len == 0 && af->fops->eof(af)) { /* On EOF returns -1 if varName was specified */ len = -1; } @@ -918,7 +994,7 @@ const char *addr = Jim_String(argv[1]); socklen_t salen; - if (JimParseSocketAddress(interp, af->addr_family, addr, &sa, &salen) != JIM_OK) { + if (JimParseSocketAddress(interp, af->addr_family, SOCK_DGRAM, addr, &sa, &salen) != JIM_OK) { return JIM_ERR; } wdata = Jim_GetString(argv[0], &wlen); @@ -1017,7 +1093,7 @@ { AioFile *af = Jim_CmdPrivData(interp); - Jim_SetResultInt(interp, feof(af->fp)); + Jim_SetResultInt(interp, !!af->fops->eof(af)); return JIM_OK; } @@ -1047,7 +1123,7 @@ #if UNIX_SOCKETS case OPT_NODELETE: if (af->addr_family == PF_UNIX) { - af->openFlags |= AIO_NODELETE; + af->flags |= AIO_NODELETE; break; } /* fall through */ @@ -1058,7 +1134,7 @@ } } - return Jim_DeleteCommand(interp, Jim_String(argv[0])); + return Jim_DeleteCommand(interp, argv[0]); } static int aio_cmd_seek(Jim_Interp *interp, int argc, Jim_Obj *const *argv) @@ -1278,50 +1354,26 @@ } #ifdef jim_ext_eventloop -static void JimAioFileEventFinalizer(Jim_Interp *interp, void *clientData) -{ - Jim_Obj **objPtrPtr = clientData; - - Jim_DecrRefCount(interp, *objPtrPtr); - *objPtrPtr = NULL; -} - -static int JimAioFileEventHandler(Jim_Interp *interp, void *clientData, int mask) -{ - Jim_Obj **objPtrPtr = clientData; - - return Jim_EvalObjBackground(interp, *objPtrPtr); -} - -static int aio_eventinfo(Jim_Interp *interp, AioFile * af, unsigned mask, Jim_Obj **scriptHandlerObj, +static int aio_eventinfo(Jim_Interp *interp, AioFile * af, unsigned mask, int argc, Jim_Obj * const *argv) { if (argc == 0) { /* Return current script */ - if (*scriptHandlerObj) { - Jim_SetResult(interp, *scriptHandlerObj); + Jim_Obj *objPtr = Jim_FindFileHandler(interp, af->fd, mask); + if (objPtr) { + Jim_SetResult(interp, objPtr); } return JIM_OK; } - if (*scriptHandlerObj) { - /* Delete old handler */ - Jim_DeleteFileHandler(interp, af->fd, mask); - } + /* Delete old handler */ + Jim_DeleteFileHandler(interp, af->fd, mask); /* Now possibly add the new script(s) */ - if (Jim_Length(argv[0]) == 0) { - /* Empty script, so done */ - return JIM_OK; + if (Jim_Length(argv[0])) { + Jim_CreateScriptFileHandler(interp, af->fd, mask, argv[0]); } - /* A new script to add */ - Jim_IncrRefCount(argv[0]); - *scriptHandlerObj = argv[0]; - - Jim_CreateFileHandler(interp, af->fd, mask, - JimAioFileEventHandler, scriptHandlerObj, JimAioFileEventFinalizer); - return JIM_OK; } @@ -1329,21 +1381,21 @@ { AioFile *af = Jim_CmdPrivData(interp); - return aio_eventinfo(interp, af, JIM_EVENT_READABLE, &af->rEvent, argc, argv); + return aio_eventinfo(interp, af, JIM_EVENT_READABLE, argc, argv); } static int aio_cmd_writable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { AioFile *af = Jim_CmdPrivData(interp); - return aio_eventinfo(interp, af, JIM_EVENT_WRITABLE, &af->wEvent, argc, argv); + return aio_eventinfo(interp, af, JIM_EVENT_WRITABLE, argc, argv); } static int aio_cmd_onexception(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { AioFile *af = Jim_CmdPrivData(interp); - return aio_eventinfo(interp, af, JIM_EVENT_EXCEPTION, &af->eEvent, argc, argv); + return aio_eventinfo(interp, af, JIM_EVENT_EXCEPTION, argc, argv); } #endif @@ -1354,15 +1406,31 @@ SSL *ssl; SSL_CTX *ssl_ctx; int server = 0; + const char *sni = NULL; + + if (argc > 2) { + static const char * const options[] = { "-server", "-sni", NULL }; + enum { OPT_SERVER, OPT_SNI }; + int option; - if (argc == 5) { - if (!Jim_CompareStringImmediate(interp, argv[2], "-server")) { + if (Jim_GetEnum(interp, argv[2], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { return JIM_ERR; } - server = 1; - } - else if (argc != 2) { - return -1; + switch (option) { + case OPT_SERVER: + if (argc != 4 && argc != 5) { + return JIM_ERR; + } + server = 1; + break; + + case OPT_SNI: + if (argc != 4) { + return JIM_ERR; + } + sni = Jim_String(argv[3]); + break; + } } if (af->ssl) { @@ -1387,11 +1455,12 @@ } if (server) { - if (SSL_use_certificate_file(ssl, Jim_String(argv[3]), SSL_FILETYPE_PEM) != 1) { + const char *certfile = Jim_String(argv[3]); + const char *keyfile = (argc == 4) ? certfile : Jim_String(argv[4]); + if (SSL_use_certificate_file(ssl, certfile, SSL_FILETYPE_PEM) != 1) { goto out; } - - if (SSL_use_PrivateKey_file(ssl, Jim_String(argv[4]), SSL_FILETYPE_PEM) != 1) { + if (SSL_use_PrivateKey_file(ssl, keyfile, SSL_FILETYPE_PEM) != 1) { goto out; } @@ -1400,6 +1469,10 @@ } } else { + if (sni) { + /* Set server name indication if requested */ + SSL_set_tlsext_host_name(ssl, sni); + } if (SSL_connect(ssl) != 1) { goto out; } @@ -1543,7 +1616,7 @@ static const jim_subcmd_type aio_command_table[] = { { "read", - "?-nonewline? ?len?", + "?-nonewline|-pending|len?", aio_cmd_read, 0, 2, @@ -1729,7 +1802,7 @@ #if !defined(JIM_BOOTSTRAP) #if defined(JIM_SSL) { "ssl", - "?-server cert priv?", + "?-server cert ?priv?|-sni servername?", aio_cmd_ssl, 0, 3, @@ -1745,8 +1818,8 @@ }, #endif #if defined(HAVE_STRUCT_FLOCK) - { "lock ?-wait?", - NULL, + { "lock", + "?-wait?", aio_cmd_lock, 0, 1, @@ -1782,17 +1855,20 @@ Jim_Obj *const *argv) { const char *mode; + FILE *fh = NULL; + const char *filename; + int fd = -1; if (argc != 2 && argc != 3) { Jim_WrongNumArgs(interp, 1, argv, "filename ?mode?"); return JIM_ERR; } + filename = Jim_String(argv[1]); mode = (argc == 3) ? Jim_String(argv[2]) : "r"; #ifdef jim_ext_tclcompat { - const char *filename = Jim_String(argv[1]); /* If the filename starts with '|', use popen instead */ if (*filename == '|') { @@ -1806,7 +1882,61 @@ } } #endif - return JimMakeChannel(interp, NULL, -1, argv[1], "aio.handle%ld", 0, mode, 0) ? JIM_OK : JIM_ERR; +#ifndef JIM_ANSIC + if (*mode == 'R' || *mode == 'W') { + /* POSIX flags */ + #ifndef O_NOCTTY + /* mingw doesn't support this flag */ + #define O_NOCTTY 0 + #endif + static const char * const modetypes[] = { + "RDONLY", "WRONLY", "RDWR", "APPEND", "BINARY", "CREAT", "EXCL", "NOCTTY", "TRUNC", NULL + }; + static const char * const simplemodes[] = { + "r", "w", "w+" + }; + static const int modeflags[] = { + O_RDONLY, O_WRONLY, O_RDWR, O_APPEND, 0, O_CREAT, O_EXCL, O_NOCTTY, O_TRUNC, + }; + int posixflags = 0; + int len = Jim_ListLength(interp, argv[2]); + int i; + int opt; + + mode = NULL; + + for (i = 0; i < len; i++) { + Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[2], i); + if (Jim_GetEnum(interp, objPtr, modetypes, &opt, "access mode", JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + if (opt < 3) { + mode = simplemodes[opt]; + } + posixflags |= modeflags[opt]; + } + /* mode must be set here if it started with 'R' or 'W' and passed the enum check above */ + assert(mode); + fd = open(filename, posixflags, 0666); + if (fd >= 0) { + fh = fdopen(fd, mode); + if (fh == NULL) { + close(fd); + } + } + } + else +#endif + { + fh = fopen(filename, mode); + } + + if (fh == NULL) { + JimAioSetError(interp, argv[1]); + return JIM_ERR; + } + + return JimMakeChannel(interp, fh, fd, argv[1], "aio.handle%ld", 0, mode, 0) ? JIM_OK : JIM_ERR; } #if defined(JIM_SSL) && !defined(JIM_BOOTSTRAP) @@ -1842,55 +1972,47 @@ * Creates a channel for fh/fd/filename. * * If fh is not NULL, uses that as the channel (and sets AIO_KEEPOPEN). - * Otherwise, if fd is >= 0, uses that as the channel. - * Otherwise opens 'filename' with mode 'mode'. + * Otherwise fd must be >= 0, in which case it uses that as the channel. * * hdlfmt is a sprintf format for the filehandle. Anything with %ld at the end will do. * mode is used for open or fdopen. * * Creates the command and sets the name as the current result. - * Returns the AioFile pointer on sucess or NULL on failure. + * Returns the AioFile pointer on sucess or NULL on failure (only if fdopen fails). */ static AioFile *JimMakeChannel(Jim_Interp *interp, FILE *fh, int fd, Jim_Obj *filename, const char *hdlfmt, int family, const char *mode, int flags) { AioFile *af; char buf[AIO_CMD_LEN]; - - snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp)); - if (!filename) { - filename = Jim_NewStringObj(interp, buf, -1); - } - - Jim_IncrRefCount(filename); + Jim_Obj *cmdname; if (fh == NULL) { - if (fd >= 0) { + assert(fd >= 0); #ifndef JIM_ANSIC - fh = fdopen(fd, mode); -#endif - } - else - fh = fopen(Jim_String(filename), mode); + fh = fdopen(fd, mode); if (fh == NULL) { JimAioSetError(interp, filename); -#ifndef JIM_ANSIC - if (fd >= 0) { - close(fd); - } -#endif - Jim_DecrRefCount(interp, filename); + close(fd); return NULL; } +#endif + } + + snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp)); + cmdname = Jim_NewStringObj(interp, buf, -1); + if (!filename) { + filename = cmdname; } + Jim_IncrRefCount(filename); /* Create the file command */ af = Jim_Alloc(sizeof(*af)); memset(af, 0, sizeof(*af)); af->fp = fh; af->filename = filename; - af->openFlags = flags; + af->flags = flags; #ifndef JIM_ANSIC af->fd = fileno(fh); #ifdef FD_CLOEXEC @@ -1908,12 +2030,12 @@ /* Note that the command must use the global namespace, even if * the current namespace is something different */ - Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); + Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, cmdname)); return af; } -#if defined(HAVE_PIPE) || (defined(HAVE_SOCKETPAIR) && UNIX_SOCKETS) +#if defined(HAVE_PIPE) || (defined(HAVE_SOCKETPAIR) && UNIX_SOCKETS) || defined(HAVE_OPENPTY) /** * Create a pair of channels. e.g. from pipe() or socketpair() */ @@ -1958,6 +2080,26 @@ } #endif +#ifdef HAVE_OPENPTY +static int JimAioOpenPtyCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int p[2]; + static const char * const mode[2] = { "r+", "w+" }; + + if (argc != 1) { + Jim_WrongNumArgs(interp, 1, argv, ""); + return JIM_ERR; + } + + if (openpty(&p[0], &p[1], NULL, NULL, NULL) != 0) { + JimAioSetError(interp, NULL); + return JIM_ERR; + } + + return JimMakeChannelPair(interp, p, argv[0], "aio.pty%ld", 0, mode); +} +#endif + #if defined(HAVE_SOCKETS) && !defined(JIM_BOOTSTRAP) static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) @@ -1973,6 +2115,7 @@ "stream.server", "pipe", "pair", + "pty", NULL }; enum @@ -1987,6 +2130,7 @@ SOCK_STREAM_SERVER, SOCK_STREAM_PIPE, SOCK_STREAM_SOCKETPAIR, + SOCK_STREAM_PTY, }; int socktype; int sock; @@ -2133,6 +2277,13 @@ family = PF_UNIX; break; #endif +#ifdef HAVE_OPENPTY + case SOCK_STREAM_PTY: + if (addr || ipv6) { + goto wrongargs; + } + return JimAioOpenPtyCommand(interp, 1, &argv[1]); +#endif default: Jim_SetResultString(interp, "Unsupported socket type", -1); @@ -2146,7 +2297,7 @@ return JIM_ERR; } if (bind_addr) { - if (JimParseSocketAddress(interp, family, bind_addr, &sa, &salen) != JIM_OK) { + if (JimParseSocketAddress(interp, family, type, bind_addr, &sa, &salen) != JIM_OK) { close(sock); return JIM_ERR; } @@ -2160,7 +2311,7 @@ } } if (connect_addr) { - if (JimParseSocketAddress(interp, family, connect_addr, &sa, &salen) != JIM_OK) { + if (JimParseSocketAddress(interp, family, type, connect_addr, &sa, &salen) != JIM_OK) { close(sock); return JIM_ERR; } diff -Nru jimtcl-0.79+dfsg0/jim-array.c jimtcl-0.81+dfsg0/jim-array.c --- jimtcl-0.79+dfsg0/jim-array.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-array.c 2021-11-27 23:06:54.000000000 +0000 @@ -114,7 +114,8 @@ return JIM_OK; } - if (Jim_DictPairs(interp, objPtr, &dictValuesObj, &len) != JIM_OK) { + dictValuesObj = Jim_DictPairs(interp, objPtr, &len); + if (dictValuesObj == NULL) { /* Variable is not an array - tclsh ignores this and returns nothing - be compatible */ Jim_SetResultString(interp, "", -1); return JIM_OK; @@ -128,7 +129,6 @@ Jim_DictAddElement(interp, resultObj, dictValuesObj[i], dictValuesObj[i + 1]); } } - Jim_Free(dictValuesObj); Jim_SetVariable(interp, argv[0], resultObj); return JIM_OK; @@ -259,9 +259,7 @@ int Jim_arrayInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "array", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "array"); Jim_CreateCommand(interp, "array", Jim_SubCmdProc, (void *)array_command_table, NULL); return JIM_OK; } diff -Nru jimtcl-0.79+dfsg0/jim.c jimtcl-0.81+dfsg0/jim.c --- jimtcl-0.79+dfsg0/jim.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim.c 2021-11-27 23:06:54.000000000 +0000 @@ -64,7 +64,7 @@ #ifdef HAVE_SYS_TIME_H #include #endif -#ifdef HAVE_BACKTRACE +#ifdef HAVE_EXECINFO_H #include #endif #ifdef HAVE_CRT_EXTERNS_H @@ -119,6 +119,7 @@ #endif #ifdef JIM_OPTIMIZATION +static int JimIsWide(Jim_Obj *objPtr); #define JIM_IF_OPTIM(X) X #else #define JIM_IF_OPTIM(X) @@ -138,19 +139,20 @@ static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action); static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr, int flags); +static int Jim_ListIndices(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *const *indexv, int indexc, + Jim_Obj **resultObj, int flags); static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands); static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr); static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr); -static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len); static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype, const char *prefix, const char *const *tablePtr, const char *name); static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv); static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr); static int JimSign(jim_wide w); -static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr); static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen); static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len); - +static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_Var *var); +static Jim_Var *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr); /* Fast access to the int (wide) value of an object which is known to be of int type */ #define JimWideValue(objPtr) (objPtr)->internalRep.wideValue @@ -186,12 +188,13 @@ * * Returns NULL on no match. */ -static const char *JimCharsetMatch(const char *pattern, int c, int flags) +static const char *JimCharsetMatch(const char *pattern, int plen, int c, int flags) { int not = 0; int pchar; int match = 0; int nocase = 0; + int n; if (flags & JIM_NOCASE) { nocase++; @@ -202,6 +205,7 @@ if (*pattern == '^') { not++; pattern++; + plen--; } /* Special case. If the first char is ']', it is part of the set */ @@ -210,22 +214,27 @@ } } - while (*pattern && *pattern != ']') { + while (plen && *pattern != ']') { /* Exact match */ if (pattern[0] == '\\') { first: - pattern += utf8_tounicode_case(pattern, &pchar, nocase); + n = utf8_tounicode_case(pattern, &pchar, nocase); + pattern += n; + plen -= n; } else { /* Is this a range? a-z */ int start; int end; - pattern += utf8_tounicode_case(pattern, &start, nocase); - if (pattern[0] == '-' && pattern[1]) { + n = utf8_tounicode_case(pattern, &start, nocase); + pattern += n; + plen -= n; + if (pattern[0] == '-' && plen > 1) { /* skip '-' */ - pattern++; - pattern += utf8_tounicode_case(pattern, &end, nocase); + n = 1 + utf8_tounicode_case(pattern + 1, &end, nocase); + pattern += n; + plen -= n; /* Handle reversed range too */ if ((c >= start && c <= end) || (c >= end && c <= start)) { @@ -251,39 +260,52 @@ /* Note: string *must* be valid UTF-8 sequences */ -static int JimGlobMatch(const char *pattern, const char *string, int nocase) +static int JimGlobMatch(const char *pattern, int plen, const char *string, int slen, int nocase) { int c; int pchar; - while (*pattern) { + int n; + const char *p; + while (plen) { switch (pattern[0]) { case '*': - while (pattern[1] == '*') { + while (pattern[1] == '*' && plen) { pattern++; + plen--; } pattern++; - if (!pattern[0]) { + plen--; + if (!plen) { return 1; /* match */ } - while (*string) { + while (slen) { /* Recursive call - Does the remaining pattern match anywhere? */ - if (JimGlobMatch(pattern, string, nocase)) + if (JimGlobMatch(pattern, plen, string, slen, nocase)) return 1; /* match */ - string += utf8_tounicode(string, &c); + n = utf8_tounicode(string, &c); + string += n; + slen -= n; } return 0; /* no match */ case '?': - string += utf8_tounicode(string, &c); + n = utf8_tounicode(string, &c); + string += n; + slen -= n; break; case '[': { - string += utf8_tounicode(string, &c); - pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0); - if (!pattern) { + n = utf8_tounicode(string, &c); + string += n; + slen -= n; + p = JimCharsetMatch(pattern + 1, plen - 1, c, nocase ? JIM_NOCASE : 0); + if (!p) { return 0; } - if (!*pattern) { + plen -= p - pattern; + pattern = p; + + if (!plen) { /* Ran out of pattern (no ']') */ continue; } @@ -292,79 +314,65 @@ case '\\': if (pattern[1]) { pattern++; + plen--; } /* fall through */ default: - string += utf8_tounicode_case(string, &c, nocase); + n = utf8_tounicode_case(string, &c, nocase); + string += n; + slen -= n; utf8_tounicode_case(pattern, &pchar, nocase); if (pchar != c) { return 0; } break; } - pattern += utf8_tounicode_case(pattern, &pchar, nocase); - if (!*string) { - while (*pattern == '*') { + n = utf8_tounicode_case(pattern, &pchar, nocase); + pattern += n; + plen -= n; + if (!slen) { + while (*pattern == '*' && plen) { pattern++; + plen--; } break; } } - if (!*pattern && !*string) { + if (!plen && !slen) { return 1; } return 0; } /** - * string comparison. Works on binary data. + * utf-8 string comparison. case-insensitive if nocase is set. * * Returns -1, 0 or 1 * - * Note that the lengths are byte lengths, not char lengths. + * Note that the lengths are character lengths, not byte lengths. */ -static int JimStringCompare(const char *s1, int l1, const char *s2, int l2) +static int JimStringCompareUtf8(const char *s1, int l1, const char *s2, int l2, int nocase) { - if (l1 < l2) { - return memcmp(s1, s2, l1) <= 0 ? -1 : 1; - } - else if (l2 < l1) { - return memcmp(s1, s2, l2) >= 0 ? 1 : -1; - } - else { - return JimSign(memcmp(s1, s2, l1)); + int minlen = l1; + if (l2 < l1) { + minlen = l2; } -} - -/** - * Compare null terminated strings, up to a maximum of 'maxchars' characters, - * (or end of string if 'maxchars' is -1). - * - * Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively. - * - * Note: does not support embedded nulls. - */ -static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase) -{ - while (*s1 && *s2 && maxchars) { + while (minlen) { int c1, c2; s1 += utf8_tounicode_case(s1, &c1, nocase); s2 += utf8_tounicode_case(s2, &c2, nocase); if (c1 != c2) { return JimSign(c1 - c2); } - maxchars--; + minlen--; } - if (!maxchars) { - return 0; + /* Equal to this point, so the shorter string is less */ + if (l1 < l2) { + return -1; } - /* One string or both terminated */ - if (*s1) { + if (l1 > l2) { return 1; } - if (*s2) { - return -1; - } return 0; } @@ -459,13 +467,15 @@ } /* Parses the front of a number to determine its sign and base. - * Returns the index to start parsing according to the given base + * Returns the index to start parsing according to the given base. + * Sets *base to zero if *str contains no indicator of its base and + * to the base (2, 8, 10 or 16) otherwise. */ static int JimNumberBase(const char *str, int *base, int *sign) { int i = 0; - *base = 10; + *base = 0; while (isspace(UCHAR(str[i]))) { i++; @@ -483,7 +493,7 @@ } if (str[i] != '0') { - /* base 10 */ + /* no base indicator */ return 0; } @@ -492,6 +502,7 @@ case 'x': case 'X': *base = 16; break; case 'o': case 'O': *base = 8; break; case 'b': case 'B': *base = 2; break; + case 'd': case 'D': *base = 10; break; default: return 0; } i += 2; @@ -500,8 +511,8 @@ /* Parse according to this base */ return i; } - /* Parse as base 10 */ - *base = 10; + /* Parse as default */ + *base = 0; return 0; } @@ -514,7 +525,7 @@ int base; int i = JimNumberBase(str, &base, &sign); - if (base != 10) { + if (base != 0) { long value = strtol(str + i, endptr, base); if (endptr == NULL || *endptr != str + i) { return value * sign; @@ -536,7 +547,7 @@ int base; int i = JimNumberBase(str, &base, &sign); - if (base != 10) { + if (base != 0) { jim_wide value = strtoull(str + i, endptr, base); if (endptr == NULL || *endptr != str + i) { return value * sign; @@ -626,7 +637,7 @@ fprintf(stderr, "\n\n"); va_end(ap); -#ifdef HAVE_BACKTRACE +#if defined(HAVE_BACKTRACE) { void *array[40]; int size, i; @@ -714,15 +725,15 @@ return key; } -/* Generic hash function (we are using to multiply by 9 and add the byte - * as Tcl) */ -unsigned int Jim_GenHashFunction(const unsigned char *buf, int len) -{ - unsigned int h = 0; - - while (len--) - h += (h << 3) + *buf++; - return h; +/* Generic string hash function */ +unsigned int Jim_GenHashFunction(const unsigned char *string, int length) +{ + unsigned result = 0; + string += length; + while (length--) { + result += (result << 3) + (unsigned char)(*--string); + } + return result; } /* ----------------------------- API implementation ------------------------- */ @@ -821,14 +832,12 @@ *ht = n; } -/* Add an element to the target hash table */ +/* Add an element to the target hash table + * Returns JIM_ERR if the entry already exists + */ int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val) { - Jim_HashEntry *entry; - - /* Get the index of the new element, or -1 if - * the element already exists. */ - entry = JimInsertHashEntry(ht, key, 0); + Jim_HashEntry *entry = JimInsertHashEntry(ht, key, 0);; if (entry == NULL) return JIM_ERR; @@ -874,41 +883,44 @@ return existed; } -/* Search and remove an element */ +/** + * Search the hash table for the given key. + * If found, removes the hash entry and returns JIM_OK. + * Otherwise returns JIM_ERR. + */ int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key) { - unsigned int h; - Jim_HashEntry *he, *prevHe; - - if (ht->used == 0) - return JIM_ERR; - h = Jim_HashKey(ht, key) & ht->sizemask; - he = ht->table[h]; + if (ht->used) { + unsigned int h = Jim_HashKey(ht, key) & ht->sizemask; + Jim_HashEntry *prevHe = NULL; + Jim_HashEntry *he = ht->table[h]; - prevHe = NULL; - while (he) { - if (Jim_CompareHashKeys(ht, key, he->key)) { - /* Unlink the element from the list */ - if (prevHe) - prevHe->next = he->next; - else - ht->table[h] = he->next; - Jim_FreeEntryKey(ht, he); - Jim_FreeEntryVal(ht, he); - Jim_Free(he); - ht->used--; - return JIM_OK; + while (he) { + if (Jim_CompareHashKeys(ht, key, he->key)) { + /* Unlink the element from the list */ + if (prevHe) + prevHe->next = he->next; + else + ht->table[h] = he->next; + ht->used--; + Jim_FreeEntryKey(ht, he); + Jim_FreeEntryVal(ht, he); + Jim_Free(he); + return JIM_OK; + } + prevHe = he; + he = he->next; } - prevHe = he; - he = he->next; } - return JIM_ERR; /* not found */ + /* not found */ + return JIM_ERR; } -/* Remove all entries from the hash table - * and leave it empty for reuse +/** + * Clear all hash entries from the table, but don't free + * the table. */ -int Jim_FreeHashTable(Jim_HashTable *ht) +void Jim_ClearHashTable(Jim_HashTable *ht) { unsigned int i; @@ -916,8 +928,7 @@ for (i = 0; ht->used > 0; i++) { Jim_HashEntry *he, *nextHe; - if ((he = ht->table[i]) == NULL) - continue; + he = ht->table[i]; while (he) { nextHe = he->next; Jim_FreeEntryKey(ht, he); @@ -926,7 +937,16 @@ ht->used--; he = nextHe; } + ht->table[i] = NULL; } +} + +/* Remove all entries from the hash table + * and leave it empty for reuse + */ +int Jim_FreeHashTable(Jim_HashTable *ht) +{ + Jim_ClearHashTable(ht); /* Free the table and the allocated cache structure */ Jim_Free(ht->table); /* Re-initialize the table */ @@ -1009,7 +1029,12 @@ /* Returns the index of a free slot that can be populated with * a hash entry for the given 'key'. - * If the key already exists, -1 is returned. */ + * If the key already exists the result depends upon whether 'replace' is set. + * If replace is false, returns NULL. + * Otherwise returns the existing hash entry. + * Note that existing vs new cases can be distinguished because he->key will be NULL + * if the key is new + */ static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace) { unsigned int h; @@ -1252,6 +1277,9 @@ pc->tend = pc->p - 1; pc->tline = pc->linenr; pc->tt = JIM_TT_EOL; + if (pc->inquote) { + pc->missing.ch = '"'; + } pc->eof = 1; return JIM_OK; } @@ -1509,6 +1537,9 @@ case '"': if (startofword) { JimParseSubQuote(pc); + if (pc->missing.ch == '"') { + return; + } continue; } break; @@ -2545,36 +2576,19 @@ */ int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase) { - return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase); + int plen, slen; + const char *pattern = Jim_GetString(patternObjPtr, &plen); + const char *string = Jim_GetString(objPtr, &slen); + return JimGlobMatch(pattern, plen, string, slen, nocase); } -/* - * Note: does not support embedded nulls for the nocase option. - */ int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase) { - int l1, l2; - const char *s1 = Jim_GetString(firstObjPtr, &l1); - const char *s2 = Jim_GetString(secondObjPtr, &l2); - - if (nocase) { - /* Do a character compare for nocase */ - return JimStringCompareLen(s1, s2, -1, nocase); - } - return JimStringCompare(s1, l1, s2, l2); -} - -/** - * Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr. - * - * Note: does not support embedded nulls - */ -int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase) -{ const char *s1 = Jim_String(firstObjPtr); + int l1 = Jim_Utf8Length(interp, firstObjPtr); const char *s2 = Jim_String(secondObjPtr); - - return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase); + int l2 = Jim_Utf8Length(interp, secondObjPtr); + return JimStringCompareUtf8(s1, l1, s2, l2, nocase); } /* Convert a range, as returned by Jim_GetRange(), into @@ -2584,7 +2598,7 @@ * is out of range. */ static int JimRelToAbsIndex(int len, int idx) { - if (idx < 0) + if (idx < 0 && idx > -INT_MAX) return len + idx; return idx; } @@ -3197,7 +3211,7 @@ FreeScriptInternalRep, DupScriptInternalRep, NULL, - JIM_TYPE_REFERENCES, + JIM_TYPE_NONE, }; /* Each token of a script is represented by a ScriptToken. @@ -3755,6 +3769,19 @@ /* ----------------------------------------------------------------------------- * Commands * ---------------------------------------------------------------------------*/ +void Jim_InterpIncrProcEpoch(Jim_Interp *interp) +{ + interp->procEpoch++; + + /* Now discard all out-of-date Jim_Cmd entries */ + while (interp->oldCmdCache) { + Jim_Cmd *next = interp->oldCmdCache->prevCmd; + Jim_Free(interp->oldCmdCache); + interp->oldCmdCache = next; + } + interp->oldCmdCacheSize = 0; +} + static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr) { cmdPtr->inUse++; @@ -3782,7 +3809,22 @@ /* Delete any pushed command too */ JimDecrCmdRefCount(interp, cmdPtr->prevCmd); } - Jim_Free(cmdPtr); + + if (interp->quitting) { + Jim_Free(cmdPtr); + } + else { + /* Preserve the structure with inUse = 0 so that + * cached references will continue to work. + * These will be discarding at the next procEpoch increment + * or once 1000 have been accumulated. + */ + cmdPtr->prevCmd = interp->oldCmdCache; + interp->oldCmdCache = cmdPtr; + if (++interp->oldCmdCacheSize >= 1000) { + Jim_InterpIncrProcEpoch(interp); + } + } } } @@ -3796,58 +3838,121 @@ Jim_Free(val); } +static unsigned int JimObjectHTHashFunction(const void *key) +{ + Jim_Obj *keyObj = (Jim_Obj *)key; + int length; + const char *string; + +#ifdef JIM_OPTIMIZATION + if (JimIsWide(keyObj) && keyObj->bytes == NULL) { + /* Special case: we can compute the hash of integers numerically. */ + jim_wide objValue = JimWideValue(keyObj); + if (objValue > INT_MIN && objValue < INT_MAX) { + unsigned result = 0; + unsigned value = (unsigned)objValue; + + if (objValue < 0) { /* wrap to positive (remove sign) */ + value = (unsigned)-objValue; + } + + /* important: use do-cycle, because value could be 0 */ + do { + result += (result << 3) + (value % 10 + '0'); + value /= 10; + } while (value); + + if (objValue < 0) { /* negative, sign as char */ + result += (result << 3) + '-'; + } + return result; + } + } +#endif + string = Jim_GetString(keyObj, &length); + return Jim_GenHashFunction((const unsigned char *)string, length); +} + +static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2) +{ + return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2); +} + +static void *JimObjectHTKeyValDup(void *privdata, const void *val) +{ + Jim_IncrRefCount((Jim_Obj *)val); + return (void *)val; +} + +static void JimObjectHTKeyValDestructor(void *interp, void *val) +{ + Jim_DecrRefCount(interp, (Jim_Obj *)val); +} + + static const Jim_HashTableType JimVariablesHashTableType = { - JimStringCopyHTHashFunction, /* hash function */ - JimStringCopyHTDup, /* key dup */ + JimObjectHTHashFunction, /* hash function */ + JimObjectHTKeyValDup, /* key dup */ NULL, /* val dup */ - JimStringCopyHTKeyCompare, /* key compare */ - JimStringCopyHTKeyDestructor, /* key destructor */ + JimObjectHTKeyCompare, /* key compare */ + JimObjectHTKeyValDestructor, /* key destructor */ JimVariablesHTValDestructor /* val destructor */ }; /* Commands HashTable Type. * - * Keys are dynamic allocated strings, Values are Jim_Cmd structures. + * Keys are Jim Objects where any leading namespace qualifier + * is ignored. Values are Jim_Cmd structures. + */ + +/** + * Like Jim_GetString() but strips any leading namespace qualifier. */ +static const char *Jim_GetStringNoQualifier(Jim_Obj *objPtr, int *length) +{ + int len; + const char *str = Jim_GetString(objPtr, &len); + if (len >= 2 && str[0] == ':' && str[1] == ':') { + while (len && *str == ':') { + len--; + str++; + } + } + *length = len; + return str; +} + +static unsigned int JimCommandsHT_HashFunction(const void *key) +{ + int len; + const char *str = Jim_GetStringNoQualifier((Jim_Obj *)key, &len); + return Jim_GenHashFunction((const unsigned char *)str, len); +} + +static int JimCommandsHT_KeyCompare(void *privdata, const void *key1, const void *key2) +{ + int len1, len2; + const char *str1 = Jim_GetStringNoQualifier((Jim_Obj *)key1, &len1); + const char *str2 = Jim_GetStringNoQualifier((Jim_Obj *)key2, &len2); + return len1 == len2 && memcmp(str1, str2, len1) == 0; +} + static void JimCommandsHT_ValDestructor(void *interp, void *val) { JimDecrCmdRefCount(interp, val); } static const Jim_HashTableType JimCommandsHashTableType = { - JimStringCopyHTHashFunction, /* hash function */ - JimStringCopyHTDup, /* key dup */ + JimCommandsHT_HashFunction, /* hash function */ + JimObjectHTKeyValDup, /* key dup */ NULL, /* val dup */ - JimStringCopyHTKeyCompare, /* key compare */ - JimStringCopyHTKeyDestructor, /* key destructor */ + JimCommandsHT_KeyCompare, /* key compare */ + JimObjectHTKeyValDestructor, /* key destructor */ JimCommandsHT_ValDestructor /* val destructor */ }; /* ------------------------- Commands related functions --------------------- */ -#ifdef jim_ext_namespace -/** - * Returns the "unscoped" version of the given namespace. - * That is, the fully qualified name without the leading :: - * The returned value is either nsObj, or an object with a zero ref count. - */ -static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj) -{ - const char *name = Jim_String(nsObj); - if (name[0] == ':' && name[1] == ':') { - /* This command is being defined in the global namespace */ - while (*++name == ':') { - } - nsObj = Jim_NewStringObj(interp, name, -1); - } - else if (Jim_Length(interp->framePtr->nsObj)) { - /* This command is being defined in a non-global namespace */ - nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj); - Jim_AppendStrings(interp, nsObj, "::", name, NULL); - } - return nsObj; -} - /** * If nameObjPtr starts with "::", returns it. * Otherwise returns a new object with nameObjPtr prefixed with "::". @@ -3855,6 +3960,7 @@ */ Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr) { +#ifdef jim_ext_namespace Jim_Obj *resultObj; const char *name = Jim_String(nameObjPtr); @@ -3867,49 +3973,47 @@ Jim_DecrRefCount(interp, nameObjPtr); return resultObj; +#else + return nameObjPtr; +#endif } /** - * An efficient version of JimQualifyNameObj() where the name is - * available (and needed) as a 'const char *'. - * Avoids creating an object if not necessary. - * The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use. + * If the name in objPtr is not fully qualified, and a non-global namespace + * is in effect, qualifies the name with the current namespace and returns the new name. + * Otherwise returns objPtr. + * + * In either case the ref count is incremented and should be decremented by the caller. + * with Jim_DecrRefCount() */ -static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr) +static Jim_Obj *JimQualifyName(Jim_Interp *interp, Jim_Obj *objPtr) { - Jim_Obj *objPtr = interp->emptyObj; - - if (name[0] == ':' && name[1] == ':') { - /* This command is being defined in the global namespace */ - while (*++name == ':') { +#ifdef jim_ext_namespace + if (Jim_Length(interp->framePtr->nsObj)) { + int len; + const char *name = Jim_GetString(objPtr, &len); + if (len < 2 || name[0] != ':' || name[1] != ':') { + /* OK. Need to qualify this name */ + objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj); + Jim_AppendStrings(interp, objPtr, "::", name, NULL); } } - else if (Jim_Length(interp->framePtr->nsObj)) { - /* This command is being defined in a non-global namespace */ - objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj); - Jim_AppendStrings(interp, objPtr, "::", name, NULL); - name = Jim_String(objPtr); - } +#endif Jim_IncrRefCount(objPtr); - *objPtrPtr = objPtr; - return name; + return objPtr; } - #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ)) - -#else - /* We can be more efficient in the no-namespace case */ - #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME)) - #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY) - -Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr) +/** + * Add the command to the commands hash table + */ +static void JimCreateCommand(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Cmd *cmd) { - return nameObjPtr; -} -#endif + /* If the entry already exists, nameObjPtr will not be used, + * so the refCount of nameObjPtr can't be zero, relying on this function to + * release it in that case. + */ + JimPanic((nameObjPtr->refCount == 0, "JimCreateCommand called with zero ref count name")); -static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd) -{ /* It may already exist, so we try to delete the old one. * Note that reference count means that it won't be deleted yet if * it exists in the call stack. @@ -3917,36 +4021,28 @@ * BUT, if 'local' is in force, instead of deleting the existing * proc, we stash a reference to the old proc here. */ - Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name); - if (he) { - /* There was an old cmd with the same name, - * so this requires a 'proc epoch' update. */ - - /* If a procedure with the same name didn't exist there is no need - * to increment the 'proc epoch' because creation of a new procedure - * can never affect existing cached commands. We don't do - * negative caching. */ - Jim_InterpIncrProcEpoch(interp); - } - - if (he && interp->local) { - /* Push this command over the top of the previous one */ - cmd->prevCmd = Jim_GetHashEntryVal(he); - Jim_SetHashVal(&interp->commands, he, cmd); - } - else { + if (interp->local) { + Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, nameObjPtr); if (he) { - /* Replace the existing command */ - Jim_DeleteHashEntry(&interp->commands, name); + /* Push this command over the top of the previous one */ + cmd->prevCmd = Jim_GetHashEntryVal(he); + Jim_SetHashVal(&interp->commands, he, cmd); + /* Need to increment the proc epoch here so that the new command will be used */ + Jim_InterpIncrProcEpoch(interp); + return; } - - Jim_AddHashEntry(&interp->commands, name, cmd); } - return JIM_OK; -} + /* Otherwise simply replace any existing command */ -int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr, + /* Note that it is not necessary to increment the 'proc epoch' because any + * existing command that is replace will be held as a negative cache entry + * until the next time the proc epoch is incremented. + */ + Jim_ReplaceHashEntry(&interp->commands, nameObjPtr, cmd); +} + +int Jim_CreateCommandObj(Jim_Interp *interp, Jim_Obj *cmdNameObj, Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc) { Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr)); @@ -3958,11 +4054,20 @@ cmdPtr->u.native.cmdProc = cmdProc; cmdPtr->u.native.privData = privData; - JimCreateCommand(interp, cmdNameStr, cmdPtr); + Jim_IncrRefCount(cmdNameObj); + JimCreateCommand(interp, cmdNameObj, cmdPtr); + Jim_DecrRefCount(interp, cmdNameObj); return JIM_OK; } + +int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr, + Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc) +{ + return Jim_CreateCommandObj(interp, Jim_NewStringObj(interp, cmdNameStr, -1), cmdProc, privData, delProc); +} + static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr) { int len, i; @@ -3998,16 +4103,12 @@ else { initObjPtr = Jim_ListGetIndex(interp, objPtr, 1); } - if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) { - return JIM_ERR; - } varPtr = Jim_Alloc(sizeof(*varPtr)); varPtr->objPtr = initObjPtr; Jim_IncrRefCount(initObjPtr); varPtr->linkFramePtr = NULL; - if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars, - Jim_String(nameObjPtr), varPtr) != JIM_OK) { + if (JimSetNewVariable(cmdPtr->u.proc.staticVars, nameObjPtr, varPtr) != JIM_OK) { Jim_SetResultFormatted(interp, "static variable name \"%#s\" duplicated in statics list", nameObjPtr); Jim_DecrRefCount(interp, initObjPtr); @@ -4024,25 +4125,47 @@ return JIM_OK; } +/* memrchr() is not standard */ +#ifdef jim_ext_namespace +static const char *Jim_memrchr(const char *p, int c, int len) +{ + int i; + for (i = len; i > 0; i--) { + if (p[i] == c) { + return p + i; + } + } + return NULL; +} +#endif + /** * If the command is a proc, sets/updates the cached namespace (nsObj) * based on the command name. */ -static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname) +static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *nameObjPtr) { #ifdef jim_ext_namespace if (cmdPtr->isproc) { + int len; + const char *cmdname = Jim_GetStringNoQualifier(nameObjPtr, &len); /* XXX: Really need JimNamespaceSplit() */ - const char *pt = strrchr(cmdname, ':'); + const char *pt = Jim_memrchr(cmdname, ':', len); if (pt && pt != cmdname && pt[-1] == ':') { + pt++; + /* Now pt points to the base name .e.g. ::abc::def::ghi points to ghi + * while cmdname points to abc + */ Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj); - cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1); + cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 2); Jim_IncrRefCount(cmdPtr->u.proc.nsObj); - if (Jim_FindHashEntry(&interp->commands, pt + 1)) { + Jim_Obj *tempObj = Jim_NewStringObj(interp, pt, len - (pt - cmdname)); + if (Jim_FindHashEntry(&interp->commands, tempObj)) { /* This command shadows a global command, so a proc epoch update is required */ Jim_InterpIncrProcEpoch(interp); } + Jim_FreeNewObj(interp, tempObj); } } #endif @@ -4059,6 +4182,7 @@ /* Allocate space for both the command pointer and the arg list */ cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen); + assert(cmdPtr); memset(cmdPtr, 0, sizeof(*cmdPtr)); cmdPtr->inUse = 1; cmdPtr->isproc = 1; @@ -4134,68 +4258,70 @@ return cmdPtr; } -int Jim_DeleteCommand(Jim_Interp *interp, const char *name) +int Jim_DeleteCommand(Jim_Interp *interp, Jim_Obj *nameObj) { int ret = JIM_OK; - Jim_Obj *qualifiedNameObj; - const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj); - if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) { - Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name); + nameObj = JimQualifyName(interp, nameObj); + + if (Jim_DeleteHashEntry(&interp->commands, nameObj) == JIM_ERR) { + Jim_SetResultFormatted(interp, "can't delete \"%#s\": command doesn't exist", nameObj); ret = JIM_ERR; } - else { - Jim_InterpIncrProcEpoch(interp); - } - - JimFreeQualifiedName(interp, qualifiedNameObj); + Jim_DecrRefCount(interp, nameObj); return ret; } -int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName) +int Jim_RenameCommand(Jim_Interp *interp, Jim_Obj *oldNameObj, Jim_Obj *newNameObj) { int ret = JIM_ERR; Jim_HashEntry *he; Jim_Cmd *cmdPtr; - Jim_Obj *qualifiedOldNameObj; - Jim_Obj *qualifiedNewNameObj; - const char *fqold; - const char *fqnew; - if (newName[0] == 0) { - return Jim_DeleteCommand(interp, oldName); + if (Jim_Length(newNameObj) == 0) { + return Jim_DeleteCommand(interp, oldNameObj); } - fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj); - fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj); + /* each name may need to have the current namespace added to it */ + + oldNameObj = JimQualifyName(interp, oldNameObj); + newNameObj = JimQualifyName(interp, newNameObj); /* Does it exist? */ - he = Jim_FindHashEntry(&interp->commands, fqold); + he = Jim_FindHashEntry(&interp->commands, oldNameObj); if (he == NULL) { - Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName); + Jim_SetResultFormatted(interp, "can't rename \"%#s\": command doesn't exist", oldNameObj); } - else if (Jim_FindHashEntry(&interp->commands, fqnew)) { - Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName); + else if (Jim_FindHashEntry(&interp->commands, newNameObj)) { + Jim_SetResultFormatted(interp, "can't rename to \"%#s\": command already exists", newNameObj); } else { - /* Add the new name first */ cmdPtr = Jim_GetHashEntryVal(he); - JimIncrCmdRefCount(cmdPtr); - JimUpdateProcNamespace(interp, cmdPtr, fqnew); - Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr); + if (cmdPtr->prevCmd) { + /* If the command replaced another command with 'local', renaming it + * would break the usage of upcall, so don't allow it. + */ + Jim_SetResultFormatted(interp, "can't rename local command \"%#s\"", oldNameObj); + } + else { + /* Add the new name first */ + JimIncrCmdRefCount(cmdPtr); + JimUpdateProcNamespace(interp, cmdPtr, newNameObj); + Jim_AddHashEntry(&interp->commands, newNameObj, cmdPtr); - /* Now remove the old name */ - Jim_DeleteHashEntry(&interp->commands, fqold); + /* Now remove the old name */ + Jim_DeleteHashEntry(&interp->commands, oldNameObj); - /* Increment the epoch */ - Jim_InterpIncrProcEpoch(interp); + /* Increment the epoch */ + Jim_InterpIncrProcEpoch(interp); - ret = JIM_OK; + ret = JIM_OK; + } } - JimFreeQualifiedName(interp, qualifiedOldNameObj); - JimFreeQualifiedName(interp, qualifiedNewNameObj); + Jim_DecrRefCount(interp, oldNameObj); + Jim_DecrRefCount(interp, newNameObj); return ret; } @@ -4239,46 +4365,30 @@ /* In order to be valid, the proc epoch must match and * the lookup must have occurred in the same namespace */ - if (objPtr->typePtr != &commandObjType || - objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch + if (objPtr->typePtr == &commandObjType + && objPtr->internalRep.cmdValue.procEpoch == interp->procEpoch #ifdef jim_ext_namespace - || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj) + && Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj) #endif - ) { - /* Not cached or out of date, so lookup */ - - /* Do we need to try the local namespace? */ - const char *name = Jim_String(objPtr); - Jim_HashEntry *he; - - if (name[0] == ':' && name[1] == ':') { - while (*++name == ':') { - } - } + && objPtr->internalRep.cmdValue.cmdPtr->inUse) { + /* Cached value is valid */ + cmd = objPtr->internalRep.cmdValue.cmdPtr; + } + else { + Jim_Obj *qualifiedNameObj = JimQualifyName(interp, objPtr); + Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, qualifiedNameObj); #ifdef jim_ext_namespace - else if (Jim_Length(interp->framePtr->nsObj)) { - /* This command is being defined in a non-global namespace */ - Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj); - Jim_AppendStrings(interp, nameObj, "::", name, NULL); - he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj)); - Jim_FreeNewObj(interp, nameObj); - if (he) { - goto found; - } + if (he == NULL && Jim_Length(interp->framePtr->nsObj)) { + he = Jim_FindHashEntry(&interp->commands, objPtr); } #endif - - /* Lookup in the global namespace */ - he = Jim_FindHashEntry(&interp->commands, name); if (he == NULL) { if (flags & JIM_ERRMSG) { Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr); } + Jim_DecrRefCount(interp, qualifiedNameObj); return NULL; } -#ifdef jim_ext_namespace -found: -#endif cmd = Jim_GetHashEntryVal(he); /* Free the old internal rep and set the new one. */ @@ -4288,9 +4398,7 @@ objPtr->internalRep.cmdValue.cmdPtr = cmd; objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj; Jim_IncrRefCount(interp->framePtr->nsObj); - } - else { - cmd = objPtr->internalRep.cmdValue.cmdPtr; + Jim_DecrRefCount(interp, qualifiedNameObj); } while (cmd->u.proc.upcall) { cmd = cmd->prevCmd; @@ -4318,38 +4426,18 @@ JIM_TYPE_REFERENCES, }; -/** - * Check that the name does not contain embedded nulls. - * - * Variable and procedure names are manipulated as null terminated strings, so - * don't allow names with embedded nulls. - */ -static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr) -{ - /* Variable names and proc names can't contain embedded nulls */ - if (nameObjPtr->typePtr != &variableObjType) { - int len; - const char *str = Jim_GetString(nameObjPtr, &len); - if (memchr(str, '\0', len)) { - Jim_SetResultFormatted(interp, "%s name contains embedded null", type); - return JIM_ERR; - } - } - return JIM_OK; -} - -/* This method should be called only by the variable API. - * It returns JIM_OK on success (variable already exists), - * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not - * a variable name, but syntax glue for [dict] i.e. the last - * character is ')' */ -static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +/* This method should be called only by the variable API. + * It returns JIM_OK on success (variable already exists), + * JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not + * a variable name, but syntax glue for [dict] i.e. the last + * character is ')' */ +static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) { const char *varName; Jim_CallFrame *framePtr; - Jim_HashEntry *he; int global; int len; + Jim_Var *var; /* Check if the object is already an uptodate variable */ if (objPtr->typePtr == &variableObjType) { @@ -4363,10 +4451,6 @@ else if (objPtr->typePtr == &dictSubstObjType) { return JIM_DICT_SUGAR; } - else if (JimValidName(interp, "variable", objPtr) != JIM_OK) { - return JIM_ERR; - } - varName = Jim_GetString(objPtr, &len); @@ -4376,33 +4460,37 @@ } if (varName[0] == ':' && varName[1] == ':') { - while (*++varName == ':') { + while (*varName == ':') { + varName++; + len--; } global = 1; framePtr = interp->topFramePtr; + /* XXX should use length */ + Jim_Obj *tempObj = Jim_NewStringObj(interp, varName, len); + var = JimFindVariable(&framePtr->vars, tempObj); + Jim_FreeNewObj(interp, tempObj); } else { global = 0; framePtr = interp->framePtr; - } - - /* Resolve this name in the variables hash table */ - he = Jim_FindHashEntry(&framePtr->vars, varName); - if (he == NULL) { - if (!global && framePtr->staticVars) { + /* Resolve this name in the variables hash table */ + var = JimFindVariable(&framePtr->vars, objPtr); + if (var == NULL && framePtr->staticVars) { /* Try with static vars. */ - he = Jim_FindHashEntry(framePtr->staticVars, varName); - } - if (he == NULL) { - return JIM_ERR; + var = JimFindVariable(framePtr->staticVars, objPtr); } } + if (var == NULL) { + return JIM_ERR; + } + /* Free the old internal repr and set the new one. */ Jim_FreeIntRep(interp, objPtr); objPtr->typePtr = &variableObjType; objPtr->internalRep.varValue.callFrameId = framePtr->id; - objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he); + objPtr->internalRep.varValue.varPtr = var; objPtr->internalRep.varValue.global = global; return JIM_OK; } @@ -4411,11 +4499,31 @@ static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr); static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags); +static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_Var *var) +{ + return Jim_AddHashEntry(ht, nameObjPtr, var); +} + +static Jim_Var *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr) +{ + Jim_HashEntry *he = Jim_FindHashEntry(ht, nameObjPtr); + if (he) { + return (Jim_Var *)Jim_GetHashEntryVal(he); + } + return NULL; +} + +static int JimUnsetVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr) +{ + return Jim_DeleteHashEntry(ht, nameObjPtr); +} + static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr) { const char *name; Jim_CallFrame *framePtr; int global; + int len; /* New variable to create */ Jim_Var *var = Jim_Alloc(sizeof(*var)); @@ -4424,21 +4532,22 @@ Jim_IncrRefCount(valObjPtr); var->linkFramePtr = NULL; - name = Jim_String(nameObjPtr); + name = Jim_GetString(nameObjPtr, &len); if (name[0] == ':' && name[1] == ':') { - while (*++name == ':') { + while (*name == ':') { + name++; + len--; } framePtr = interp->topFramePtr; global = 1; + JimSetNewVariable(&framePtr->vars, Jim_NewStringObj(interp, name, len), var); } else { framePtr = interp->framePtr; global = 0; + JimSetNewVariable(&framePtr->vars, nameObjPtr, var); } - /* Insert the new variable */ - Jim_AddHashEntry(&framePtr->vars, name, var); - /* Make the object int rep a variable */ Jim_FreeIntRep(interp, nameObjPtr); nameObjPtr->typePtr = &variableObjType; @@ -4468,9 +4577,6 @@ return JimDictSugarSet(interp, nameObjPtr, valObjPtr); case JIM_ERR: - if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) { - return JIM_ERR; - } JimCreateVariable(interp, nameObjPtr, valObjPtr); break; @@ -4538,6 +4644,8 @@ const char *targetName; Jim_CallFrame *framePtr; Jim_Var *varPtr; + int len; + int varnamelen; /* Check for an existing variable or link */ switch (SetVariableFromAny(interp, nameObjPtr)) { @@ -4561,10 +4669,12 @@ /* Resolve the call frames for both variables */ /* XXX: SetVariableFromAny() already did this! */ - varName = Jim_String(nameObjPtr); + varName = Jim_GetString(nameObjPtr, &varnamelen); if (varName[0] == ':' && varName[1] == ':') { - while (*++varName == ':') { + while (*varName == ':') { + varName++; + varnamelen--; } /* Linking a global var does nothing */ framePtr = interp->topFramePtr; @@ -4573,11 +4683,13 @@ framePtr = interp->framePtr; } - targetName = Jim_String(targetNameObjPtr); + targetName = Jim_GetString(targetNameObjPtr, &len); if (targetName[0] == ':' && targetName[1] == ':') { - while (*++targetName == ':') { + while (*targetName == ':') { + targetName++; + len--; } - targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1); + targetNameObjPtr = Jim_NewStringObj(interp, targetName, len); targetCallFrame = interp->topFramePtr; } Jim_IncrRefCount(targetNameObjPtr); @@ -4596,7 +4708,7 @@ /* Cycles are only possible with 'uplevel 0' */ while (1) { - if (strcmp(Jim_String(objPtr), varName) == 0) { + if (Jim_Length(objPtr) == varnamelen && memcmp(Jim_String(objPtr), varName, varnamelen) == 0) { Jim_SetResultString(interp, "can't upvar from variable to itself", -1); Jim_DecrRefCount(interp, targetNameObjPtr); return JIM_ERR; @@ -4630,6 +4742,9 @@ */ Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags) { + if (interp->safeexpr) { + return nameObjPtr; + } switch (SetVariableFromAny(interp, nameObjPtr)) { case JIM_OK:{ Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr; @@ -4727,16 +4842,23 @@ interp->framePtr = framePtr; } else { - const char *name = Jim_String(nameObjPtr); if (nameObjPtr->internalRep.varValue.global) { - name += 2; + int len; + const char *name = Jim_GetString(nameObjPtr, &len); + while (*name == ':') { + name++; + len--; + } framePtr = interp->topFramePtr; + Jim_Obj *tempObj = Jim_NewStringObj(interp, name, len); + retval = JimUnsetVariable(&framePtr->vars, tempObj); + Jim_FreeNewObj(interp, tempObj); } else { framePtr = interp->framePtr; + retval = JimUnsetVariable(&framePtr->vars, nameObjPtr); } - retval = Jim_DeleteHashEntry(&framePtr->vars, name); if (retval == JIM_OK) { /* Change the callframe id, invalidating var lookup caching */ framePtr->id = interp->callFrameEpoch++; @@ -4914,6 +5036,10 @@ Jim_Obj *resObjPtr = NULL; Jim_Obj *substKeyObjPtr = NULL; + if (interp->safeexpr) { + return objPtr; + } + SetDictSubstFromAny(interp, objPtr); if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr, @@ -4975,14 +5101,8 @@ Jim_Obj *cmdNameObj; while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) { - Jim_HashEntry *he; - Jim_Obj *fqObjName; Jim_HashTable *ht = &interp->commands; - - const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName); - - he = Jim_FindHashEntry(ht, fqname); - + Jim_HashEntry *he = Jim_FindHashEntry(ht, cmdNameObj); if (he) { Jim_Cmd *cmd = Jim_GetHashEntryVal(he); if (cmd->prevCmd) { @@ -4996,12 +5116,10 @@ Jim_SetHashVal(ht, he, prevCmd); } else { - Jim_DeleteHashEntry(ht, fqname); + Jim_DeleteHashEntry(ht, cmdNameObj); } - Jim_InterpIncrProcEpoch(interp); } Jim_DecrRefCount(interp, cmdNameObj); - JimFreeQualifiedName(interp, fqObjName); } Jim_FreeStack(localCommands); Jim_Free(localCommands); @@ -5021,11 +5139,10 @@ Jim_Obj *objPtr; /* Fast check for the likely case that the variable doesn't exist */ - if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) { + if (JimFindVariable(&interp->framePtr->vars, interp->defer) == NULL) { return retcode; } - - objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE); + objPtr = Jim_GetVariable(interp, interp->defer, JIM_NONE); if (objPtr) { int ret = JIM_OK; @@ -5080,24 +5197,7 @@ if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE) Jim_FreeHashTable(&cf->vars); else { - int i; - Jim_HashEntry **table = cf->vars.table, *he; - - for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) { - he = table[i]; - while (he != NULL) { - Jim_HashEntry *nextEntry = he->next; - Jim_Var *varPtr = Jim_GetHashEntryVal(he); - - Jim_DecrRefCount(interp, varPtr->objPtr); - Jim_Free(Jim_GetHashEntryKey(he)); - Jim_Free(varPtr); - Jim_Free(he); - table[i] = NULL; - he = nextEntry; - } - } - cf->vars.used = 0; + Jim_ClearHashTable(&cf->vars); } cf->next = interp->freeFramesList; interp->freeFramesList = cf; @@ -5405,6 +5505,15 @@ objPtr = objPtr->nextObjPtr; continue; } + + /* If the string is ::refCount == 1 && Jim_FindHashEntry(&interp->commands, objPtr)) { +#ifdef JIM_DEBUG_GC + printf("No MARK: %lu - command with refcount=1\n", id); +#endif + break; + } + Jim_AddHashEntry(&marks, &id, objPtr); #ifdef JIM_DEBUG_GC - printf("MARK: %d\n", (int)id); + printf("MARK: %lu (type=%s)\n", id, JimObjTypeName(objPtr)); #endif p += JIM_REFERENCE_SPACE; } @@ -5484,20 +5603,20 @@ } Jim_FreeHashTable(&marks); interp->lastCollectId = interp->referenceNextId; - interp->lastCollectTime = time(NULL); + interp->lastCollectTime = JimClock(); return collected; } -#define JIM_COLLECT_ID_PERIOD 5000 -#define JIM_COLLECT_TIME_PERIOD 300 +#define JIM_COLLECT_ID_PERIOD 5000000 +#define JIM_COLLECT_TIME_PERIOD 300000 void Jim_CollectIfNeeded(Jim_Interp *interp) { unsigned long elapsedId; - int elapsedTime; + jim_wide elapsedTime; elapsedId = interp->referenceNextId - interp->lastCollectId; - elapsedTime = time(NULL) - interp->lastCollectTime; + elapsedTime = JimClock() - interp->lastCollectTime; if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) { @@ -5528,7 +5647,7 @@ i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH; i->maxEvalDepth = JIM_MAX_EVAL_DEPTH; - i->lastCollectTime = time(NULL); + i->lastCollectTime = JimClock(); /* Note that we can create objects only after the * interpreter liveList and freeList pointers are @@ -5547,6 +5666,7 @@ i->result = i->emptyObj; i->stackTrace = Jim_NewListObj(i, NULL, 0); i->unknown = Jim_NewStringObj(i, "unknown", -1); + i->defer = Jim_NewStringObj(i, "jim::defer", -1); i->errorProc = i->emptyObj; i->currentScriptObj = Jim_NewEmptyStringObj(i); i->nullScriptObj = Jim_NewEmptyStringObj(i); @@ -5555,6 +5675,7 @@ Jim_IncrRefCount(i->result); Jim_IncrRefCount(i->stackTrace); Jim_IncrRefCount(i->unknown); + Jim_IncrRefCount(i->defer); Jim_IncrRefCount(i->currentScriptObj); Jim_IncrRefCount(i->nullScriptObj); Jim_IncrRefCount(i->errorProc); @@ -5571,6 +5692,7 @@ Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR); Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian"); Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0"); + Jim_SetVariableStrWithStr(i, "tcl_platform(bootstrap)", "0"); Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *))); Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide))); @@ -5583,6 +5705,8 @@ Jim_Obj *objPtr, *nextObjPtr; + i->quitting = 1; + /* Free the active call frames list - must be done before i->commands is destroyed */ for (cf = i->framePtr; cf; cf = cfx) { /* Note that we ignore any errors */ @@ -5598,9 +5722,13 @@ Jim_DecrRefCount(i, i->stackTrace); Jim_DecrRefCount(i, i->errorProc); Jim_DecrRefCount(i, i->unknown); + Jim_DecrRefCount(i, i->defer); Jim_DecrRefCount(i, i->errorFileNameObj); Jim_DecrRefCount(i, i->currentScriptObj); Jim_DecrRefCount(i, i->nullScriptObj); + + Jim_InterpIncrProcEpoch(i); + Jim_FreeHashTable(&i->commands); #ifdef JIM_REFERENCES Jim_FreeHashTable(&i->references); @@ -5608,6 +5736,9 @@ Jim_FreeHashTable(&i->packages); Jim_Free(i->prngState); Jim_FreeHashTable(&i->assocData); + if (i->traceCmdObj) { + Jim_DecrRefCount(i, i->traceCmdObj); + } /* Check that the live object list is empty, otherwise * there is a memory leak. */ @@ -5964,6 +6095,34 @@ return JIM_OK; } +int Jim_GetWideExpr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr) +{ + int ret = JIM_OK; + if (objPtr->typePtr == &intObjType) { + *widePtr = JimWideValue(objPtr); + } + else { + /* safeexpr can never be set here, because evaluating an expression + * safely can never cause a script to be run + */ + JimPanic((interp->safeexpr, "interp->safeexpr is set")); + interp->safeexpr++; + ret = Jim_EvalExpression(interp, objPtr); + interp->safeexpr--; + + if (ret == JIM_OK) { + ret = Jim_GetWide(interp, Jim_GetResult(interp), widePtr); + } + if (ret != JIM_OK) { + /* XXX By doing this we throw away any more detailed message, + * but typical integer expressions won't be very complex + */ + Jim_SetResultFormatted(interp, "expected integer expression but got \"%#s\"", objPtr); + } + } + return ret; +} + /* Get a wide but does not set an error if the format is bad. */ static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr) { @@ -6158,23 +6317,21 @@ return JIM_OK; } +static const char * const jim_true_false_strings[8] = { + "1", "true", "yes", "on", + "0", "false", "no", "off" +}; +/* Must keep these lengths in sync with the strings above */ +static const int jim_true_false_lens[8] = { + 1, 4, 3, 2, + 1, 5, 2, 3, +}; + static int SetBooleanFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags) { - static const char * const falses[] = { - "0", "false", "no", "off", NULL - }; - static const char * const trues[] = { - "1", "true", "yes", "on", NULL - }; - - int boolean; - - int index; - if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) { - boolean = 0; - } else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) { - boolean = 1; - } else { + int index = Jim_FindByName(Jim_String(objPtr), jim_true_false_strings, + sizeof(jim_true_false_strings) / sizeof(*jim_true_false_strings)); + if (index < 0) { if (flags & JIM_ERRMSG) { Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr); } @@ -6184,7 +6341,8 @@ /* Free the old internal repr and set the new one. */ Jim_FreeIntRep(interp, objPtr); objPtr->typePtr = &intObjType; - objPtr->internalRep.wideValue = boolean; + /* 4 true values in jim_true_false_strings */ + objPtr->internalRep.wideValue = index < 4 ? 1 : 0; return JIM_OK; } @@ -6499,27 +6657,26 @@ return JIM_OK; } - /* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but - * it also preserves any source location of the dict elements - * which can be very useful - */ + /* Optimise dict -> list for object with no string rep. */ if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) { - Jim_Obj **listObjPtrPtr; - int len; - int i; - - listObjPtrPtr = JimDictPairs(objPtr, &len); - for (i = 0; i < len; i++) { - Jim_IncrRefCount(listObjPtrPtr[i]); - } + Jim_Dict *dict = objPtr->internalRep.dictValue; + /* To convert to a list we need to: + * 1. Take ownership of the table + * 2. Discard the hash table + * 3. Free the dict structure + */ - /* Now just switch the internal rep */ - Jim_FreeIntRep(interp, objPtr); + /* 1. Switch the internal rep */ objPtr->typePtr = &listObjType; - objPtr->internalRep.listValue.len = len; - objPtr->internalRep.listValue.maxLen = len; - objPtr->internalRep.listValue.ele = listObjPtrPtr; + objPtr->internalRep.listValue.len = dict->len; + objPtr->internalRep.listValue.maxLen = dict->maxLen; + objPtr->internalRep.listValue.ele = dict->table; + /* 2. Discard the hash table */ + Jim_Free(dict->ht); + + /* 3. Free the dict structure */ + Jim_Free(dict); return JIM_OK; } @@ -6586,7 +6743,7 @@ * sure that the list object can't shimmer while the vector returned * is in use, this vector is the one stored inside the internal representation * of the list object. This function is not exported, extensions should - * always access to the List object elements using Jim_ListIndex(). */ + * always access to the List object elements using Jim_ListGetIndex(). */ static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen, Jim_Obj ***listVec) { @@ -6619,8 +6776,8 @@ JIM_LSORT_COMMAND } type; int order; - int index; - int indexed; + Jim_Obj **indexv; + int indexc; int unique; int (*subfn)(Jim_Obj **, Jim_Obj **); }; @@ -6631,8 +6788,8 @@ { Jim_Obj *lObj, *rObj; - if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK || - Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) { + if (Jim_ListIndices(sort_info->interp, *lhsObj, sort_info->indexv, sort_info->indexc, &lObj, JIM_ERRMSG) != JIM_OK || + Jim_ListIndices(sort_info->interp, *rhsObj, sort_info->indexv, sort_info->indexc, &rObj, JIM_ERRMSG) != JIM_OK) { longjmp(sort_info->jmpbuf, JIM_ERR); } return sort_info->subfn(&lObj, &rObj); @@ -6774,7 +6931,7 @@ return -1; /* Should not be run but keeps static analysers happy */ } - if (info->indexed) { + if (info->indexc) { /* Need to interpose a "list index" function */ info->subfn = fn; fn = ListSortIndexHelper; @@ -6794,6 +6951,22 @@ return rc; } +/* Ensure there is room for at least 'idx' values in the list */ +static void ListEnsureLength(Jim_Obj *listPtr, int idx) +{ + assert(idx >= 0); + if (idx >= listPtr->internalRep.listValue.maxLen) { + if (idx < 4) { + /* Don't do allocations of under 4 pointers. */ + idx = 4; + } + listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele, + sizeof(Jim_Obj *) * idx); + + listPtr->internalRep.listValue.maxLen = idx; + } +} + /* This is the low-level function to insert elements into a list. * The higher-level Jim_ListInsertElements() performs shared object * check and invalidates the string repr. This version is used @@ -6812,18 +6985,11 @@ Jim_Obj **point; if (requiredLen > listPtr->internalRep.listValue.maxLen) { - if (requiredLen < 2) { - /* Don't do allocations of under 4 pointers. */ - requiredLen = 4; - } - else { + if (currentLen) { + /* Assume that we will need extra space for future expansion */ requiredLen *= 2; } - - listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele, - sizeof(Jim_Obj *) * requiredLen); - - listPtr->internalRep.listValue.maxLen = requiredLen; + ListEnsureLength(listPtr, requiredLen); } if (idx < 0) { idx = currentLen; @@ -6914,6 +7080,57 @@ return JIM_OK; } +/* Get the value from the list associated to the specified list indices. + * Return JIM_ERR if an index is invalid (and sets an error message). + * Returns -1 if the list index is out of range. + * In this case, if flags includes JIM_ERRMSG, an error result is set. + * Otherwise, returns JIM_OK and sets *resultObj to the indexed value. + * (This is the only case where *resultObj is set) + */ +static int Jim_ListIndices(Jim_Interp *interp, Jim_Obj *listPtr, + Jim_Obj *const *indexv, int indexc, Jim_Obj **resultObj, int flags) +{ + int i; + int static_idxes[5]; + int *idxes = static_idxes; + int ret = JIM_OK; + + if (indexc > sizeof(static_idxes) / sizeof(*static_idxes)) { + idxes = Jim_Alloc(indexc * sizeof(*idxes)); + } + + /* In the rare, contrived case where an index is also the list (or an element) + * we need to extract the indices first. + */ + for (i = 0; i < indexc; i++) { + ret = Jim_GetIndex(interp, indexv[i], &idxes[i]); + if (ret != JIM_OK) { + goto err; + } + } + + for (i = 0; i < indexc; i++) { + Jim_Obj *objPtr = Jim_ListGetIndex(interp, listPtr, idxes[i]); + if (!objPtr) { + if (flags & JIM_ERRMSG) { + if (idxes[i] < 0 || idxes[i] > Jim_ListLength(interp, listPtr)) { + Jim_SetResultFormatted(interp, "index \"%#s\" out of range", indexv[i]); + } + else { + Jim_SetResultFormatted(interp, "element %#s missing from sublist \"%#s\"", indexv[i], listPtr); + } + } + return -1; + } + listPtr = objPtr; + } + *resultObj = listPtr; +err: + if (idxes != static_idxes) + Jim_Free(idxes); + return ret; +} + static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj *newObjPtr, int flags) { @@ -6951,7 +7168,10 @@ listObjPtr = objPtr; if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK) goto err; - if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) { + + objPtr = Jim_ListGetIndex(interp, listObjPtr, idx); + if (objPtr == NULL) { + Jim_SetResultFormatted(interp, "index \"%#s\" out of range", indexv[i]); goto err; } if (Jim_IsShared(objPtr)) { @@ -7088,41 +7308,11 @@ static void UpdateStringOfDict(struct Jim_Obj *objPtr); static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); -/* Dict HashTable Type. +/* Dict Type. * - * Keys and Values are Jim objects. */ - -static unsigned int JimObjectHTHashFunction(const void *key) -{ - int len; - const char *str = Jim_GetString((Jim_Obj *)key, &len); - return Jim_GenHashFunction((const unsigned char *)str, len); -} - -static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2) -{ - return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2); -} - -static void *JimObjectHTKeyValDup(void *privdata, const void *val) -{ - Jim_IncrRefCount((Jim_Obj *)val); - return (void *)val; -} - -static void JimObjectHTKeyValDestructor(void *interp, void *val) -{ - Jim_DecrRefCount(interp, (Jim_Obj *)val); -} - -static const Jim_HashTableType JimDictHashTableType = { - JimObjectHTHashFunction, /* hash function */ - JimObjectHTKeyValDup, /* key dup */ - JimObjectHTKeyValDup, /* val dup */ - JimObjectHTKeyCompare, /* key compare */ - JimObjectHTKeyValDestructor, /* key destructor */ - JimObjectHTKeyValDestructor /* val destructor */ -}; + * Jim dictionaries use a specialised hash table for efficiency. + * See Jim_Dict in jim.h + */ /* Note that while the elements of the dict may contain references, * the list object itself can't. This basically means that the @@ -7136,68 +7326,220 @@ JIM_TYPE_NONE, }; -void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +/** + * Free the entire dict structure, including the key, value table, + * the hash table and the dict structure. + */ +static void JimFreeDict(Jim_Interp *interp, Jim_Dict *dict) { - JIM_NOTUSED(interp); + int i; + for (i = 0; i < dict->len; i++) { + Jim_DecrRefCount(interp, dict->table[i]); + } + Jim_Free(dict->table); + Jim_Free(dict->ht); + Jim_Free(dict); +} + +enum { + DICT_HASH_FIND = -1, + DICT_HASH_REMOVE = -2, + DICT_HASH_ADD = -3, +}; - Jim_FreeHashTable(objPtr->internalRep.ptr); - Jim_Free(objPtr->internalRep.ptr); +/** + * Search for the given key in the dict hash table and perform the given operation. + * + * op_tvoffset is one of: + * + * DICT_HASH_FIND + * - if found, returns the table value offset, otherwise 0 + * DICT_HASH_REMOVE + * - if found, removes the entry and returns the table value offset, otherwise 0 + * DICT_HASH_ADD + * - if found, does nothing and returns the table value offset. + * otherwise adds the entry with a table value offset of dict->len + 1 and returns 0 + * A table value offset (> 0) + * - in this case the entry *must* exist and the table value offset + * for the entry is updated to be op_offset. + */ +static int JimDictHashFind(Jim_Dict *dict, Jim_Obj *keyObjPtr, int op_tvoffset) +{ + unsigned h = (JimObjectHTHashFunction(keyObjPtr) + dict->uniq); + unsigned idx = h & dict->sizemask; + int tvoffset = 0; + unsigned peturb = h; + + if (dict->len) { + while ((tvoffset = dict->ht[idx].offset)) { + if (tvoffset == -1) { + /* An entry with offset=-1 is a removed entry + * we need skip it when searching, but stop when adding. + */ + if (op_tvoffset == DICT_HASH_ADD) { + tvoffset = 0; + break; + } + } + else if (dict->ht[idx].hash == h) { + if (Jim_StringEqObj(keyObjPtr, dict->table[tvoffset - 1])) { + break; + } + } + /* Use the Python algorithm for conflict resolution */ + peturb >>= 5; + idx = (5 * idx + 1 + peturb) & dict->sizemask; + } + } + + switch (op_tvoffset) { + case DICT_HASH_FIND: + /* If found return tvoffset, if not found return 0 */ + break; + case DICT_HASH_REMOVE: + if (tvoffset) { + /* Found, remove with -1 meaning a removed entry */ + dict->ht[idx].offset = -1; + } + /* else if not found, return 0 */ + break; + case DICT_HASH_ADD: + if (tvoffset == 0) { + /* Not found so add it at the end */ + dict->ht[idx].offset = dict->len + 1; + dict->ht[idx].hash = h; + } + /* else if found, return tvoffset */ + break; + default: + assert(tvoffset); + /* Found so replace the tvoffset */ + dict->ht[idx].offset = op_tvoffset; + break; + } + + return tvoffset; } -void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +/* Expand or create the hashtable to at least size 'size' + * The hash table size should have room for twice the number + * of keys to reduce collisions + */ +static void JimDictExpandHashTable(Jim_Dict *dict, unsigned int size) { - Jim_HashTable *ht, *dupHt; - Jim_HashTableIterator htiter; - Jim_HashEntry *he; + int i; + struct JimDictHashEntry *prevht = dict->ht; + int prevsize = dict->size; - /* Create a new hash table */ - ht = srcPtr->internalRep.ptr; - dupHt = Jim_Alloc(sizeof(*dupHt)); - Jim_InitHashTable(dupHt, &JimDictHashTableType, interp); - if (ht->size != 0) - Jim_ExpandHashTable(dupHt, ht->size); - /* Copy every element from the source to the dup hash table */ - JimInitHashTableIterator(ht, &htiter); - while ((he = Jim_NextHashEntry(&htiter)) != NULL) { - Jim_AddHashEntry(dupHt, he->key, he->u.val); + dict->size = JimHashTableNextPower(size); + dict->sizemask = dict->size - 1; + + /* Allocate a new table so that we don't need to recalulate hashes */ + dict->ht = Jim_Alloc(dict->size * sizeof(*dict->ht)); + memset(dict->ht, 0, dict->size * sizeof(*dict->ht)); + + /* Now add all the table entries to the new table */ + for (i = 0; i < prevsize; i++) { + if (prevht[i].offset > 0) { + /* Find the location in the new table for this entry */ + unsigned h = prevht[i].hash; + unsigned idx = h & dict->sizemask; + unsigned peturb = h; + + while (dict->ht[idx].offset) { + peturb >>= 5; + idx = (5 * idx + 1 + peturb) & dict->sizemask; + } + dict->ht[idx].offset = prevht[i].offset; + dict->ht[idx].hash = h; + } } + Jim_Free(prevht); +} - dupPtr->internalRep.ptr = dupHt; - dupPtr->typePtr = &dictObjType; +/** + * Add an entry to the hash table for 'keyObjPtr' + * If the entry already exists, returns the current tvoffset. + * Otherwise inserts a new entry with table value offset dict->len + 1 + * and returns 0. + */ +static int JimDictAdd(Jim_Dict *dict, Jim_Obj *keyObjPtr) +{ + /* If we are trying to add an entry and the hash table is too small, + * increase the size now, even if it may exist and the add would + * do nothing. + * This way we don't need to recalculate the hash index in case + * it didn't exist and is added. + */ + if (dict->size <= dict->len) { + /* The first add grows the size to 8, and thereafter it is doubled + * in size. Note that hash table sizes are always powers of two. + */ + JimDictExpandHashTable(dict, dict->size ? dict->size * 2 : 8); + } + return JimDictHashFind(dict, keyObjPtr, DICT_HASH_ADD); } -static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len) +/** + * Allocate and return a new Jim_Dict structure + * with space for 'table_size' (key, object) entries + * and hash table size 'ht_size' + * These can be 0. + */ +static Jim_Dict *JimDictNew(Jim_Interp *interp, int table_size, int ht_size) { - Jim_HashTable *ht; - Jim_HashTableIterator htiter; - Jim_HashEntry *he; - Jim_Obj **objv; + Jim_Dict *dict = Jim_Alloc(sizeof(*dict)); + memset(dict, 0, sizeof(*dict)); + + if (ht_size) { + JimDictExpandHashTable(dict, ht_size); + } + if (table_size) { + dict->table = Jim_Alloc(table_size * sizeof(*dict->table)); + dict->maxLen = table_size; + } +#ifdef JIM_RANDOMISE_HASH + /* This is initialised to a random value to avoid a hash collision attack. + * See: n.runs-SA-2011.004 + */ + dict->uniq = (rand() ^ time(NULL) ^ clock()); +#endif + return dict; +} + +static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + JimFreeDict(interp, objPtr->internalRep.dictValue); +} + +static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + Jim_Dict *oldDict = srcPtr->internalRep.dictValue; int i; - ht = dictPtr->internalRep.ptr; + /* Create a new hash table */ + Jim_Dict *newDict = JimDictNew(interp, oldDict->maxLen, oldDict->size); - /* Turn the hash table into a flat vector of Jim_Objects. */ - objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *)); - JimInitHashTableIterator(ht, &htiter); - i = 0; - while ((he = Jim_NextHashEntry(&htiter)) != NULL) { - objv[i++] = Jim_GetHashEntryKey(he); - objv[i++] = Jim_GetHashEntryVal(he); + /* Copy the table of key and value objects, incrementing the reference count of both */ + for (i = 0; i < oldDict->len; i++) { + newDict->table[i] = oldDict->table[i]; + Jim_IncrRefCount(newDict->table[i]); } - *len = i; - return objv; + newDict->len = oldDict->len; + + /* Must keep the same uniq so that the hashes agree */ + newDict->uniq = oldDict->uniq; + + /* Now copy the the hash table efficiently */ + memcpy(newDict->ht, oldDict->ht, sizeof(*oldDict->ht) * oldDict->size); + + dupPtr->internalRep.dictValue = newDict; + dupPtr->typePtr = &dictObjType; } static void UpdateStringOfDict(struct Jim_Obj *objPtr) { - /* Turn the hash table into a flat vector of Jim_Objects. */ - int len; - Jim_Obj **objv = JimDictPairs(objPtr, &len); - - /* And now generate the string rep as a list */ - JimMakeListStringRep(objPtr, objv, len); - - Jim_Free(objv); + JimMakeListStringRep(objPtr, objPtr->internalRep.dictValue->table, objPtr->internalRep.dictValue->len); } static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) @@ -7210,35 +7552,57 @@ if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) { /* A shared list, so get the string representation now to avoid - * changing the order in case of fast conversion to dict. + * losing duplicate keys from the string rep when converting to + * a dict. */ Jim_String(objPtr); } - /* For simplicity, convert a non-list object to a list and then to a dict */ + /* Convert a non-list object to a list and then to a dict + * since we will need the list of key, value pairs anyway + */ listlen = Jim_ListLength(interp, objPtr); if (listlen % 2) { Jim_SetResultString(interp, "missing value to go with key", -1); return JIM_ERR; } else { - /* Converting from a list to a dict can't fail */ - Jim_HashTable *ht; + /* Allocate space in the hash table for twice the number of elements */ + Jim_Dict *dict = JimDictNew(interp, 0, listlen); int i; - ht = Jim_Alloc(sizeof(*ht)); - Jim_InitHashTable(ht, &JimDictHashTableType, interp); + /* Take ownership of the list array */ + dict->table = objPtr->internalRep.listValue.ele; + dict->maxLen = objPtr->internalRep.listValue.maxLen; + /* Now add all the elements to the hash table */ for (i = 0; i < listlen; i += 2) { - Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i); - Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1); - - Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr); + int tvoffset = JimDictAdd(dict, dict->table[i]); + if (tvoffset) { + /* A duplicate key, so replace the value but and don't add a new entry */ + /* Discard the old value */ + Jim_DecrRefCount(interp, dict->table[tvoffset]); + /* Set the new value */ + dict->table[tvoffset] = dict->table[i + 1]; + /* Discard the duplicate key */ + Jim_DecrRefCount(interp, dict->table[i]); + } + else { + if (dict->len != i) { + /* Need to move later entries down to fill the hole created by + * a previous duplicate entry. + */ + dict->table[dict->len++] = dict->table[i]; + dict->table[dict->len++] = dict->table[i + 1]; + } + else { + dict->len += 2; + } + } } - Jim_FreeIntRep(interp, objPtr); objPtr->typePtr = &dictObjType; - objPtr->internalRep.ptr = ht; + objPtr->internalRep.dictValue = dict; return JIM_OK; } @@ -7255,13 +7619,62 @@ static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr) { - Jim_HashTable *ht = objPtr->internalRep.ptr; + Jim_Dict *dict = objPtr->internalRep.dictValue; + if (valueObjPtr == NULL) { + /* Removing an entry */ + int tvoffset = JimDictHashFind(dict, keyObjPtr, DICT_HASH_REMOVE); + if (tvoffset) { + /* Found, so we need to remove the value from the table too, and if it is not the last + * entry, need to swap with the last entry + */ + /* Remove the table entries */ + Jim_DecrRefCount(interp, dict->table[tvoffset - 1]); + Jim_DecrRefCount(interp, dict->table[tvoffset]); + dict->len -= 2; + if (tvoffset != dict->len + 1) { + /* Swap the last pair of table entries into the now empty entries */ + dict->table[tvoffset - 1] = dict->table[dict->len]; + dict->table[tvoffset] = dict->table[dict->len + 1]; - if (valueObjPtr == NULL) { /* unset */ - return Jim_DeleteHashEntry(ht, keyObjPtr); + /* Now we need to update the hash table for the swapped entry */ + JimDictHashFind(dict, dict->table[tvoffset - 1], tvoffset); + } + return JIM_OK; + } + return JIM_ERR; + } + else { + /* Adding an entry - does it already exist? */ + int tvoffset = JimDictAdd(dict, keyObjPtr); + if (tvoffset) { + /* Yes, already exists, so just replace value entry in the table */ + Jim_IncrRefCount(valueObjPtr); + Jim_DecrRefCount(interp, dict->table[tvoffset]); + dict->table[tvoffset] = valueObjPtr; + } + else { + /* No, so need to make space in the table + * and insert this entry at dict->len, dict->len + 1 + */ + if (dict->maxLen == dict->len) { + /* Expand the table */ + if (dict->maxLen < 4) { + dict->maxLen = 4; + } + else { + dict->maxLen *= 2; + } + dict->table = Jim_Realloc(dict->table, dict->maxLen * sizeof(*dict->table)); + } + Jim_IncrRefCount(keyObjPtr); + Jim_IncrRefCount(valueObjPtr); + + dict->table[dict->len++] = keyObjPtr; + dict->table[dict->len++] = valueObjPtr; + + } + return JIM_OK; } - Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr); - return JIM_OK; } /* Add an element, higher-level interface for DictAddElement(). @@ -7287,8 +7700,8 @@ objPtr = Jim_NewObj(interp); objPtr->typePtr = &dictObjType; objPtr->bytes = NULL; - objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable)); - Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp); + + objPtr->internalRep.dictValue = JimDictNew(interp, len, len); for (i = 0; i < len; i += 2) DictAddElement(interp, objPtr, elements[i], elements[i + 1]); return objPtr; @@ -7302,37 +7715,52 @@ int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr, Jim_Obj **objPtrPtr, int flags) { - Jim_HashEntry *he; - Jim_HashTable *ht; + int tvoffset; + Jim_Dict *dict; if (SetDictFromAny(interp, dictPtr) != JIM_OK) { return -1; } - ht = dictPtr->internalRep.ptr; - if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) { + dict = dictPtr->internalRep.dictValue; + tvoffset = JimDictHashFind(dict, keyPtr, DICT_HASH_FIND); + if (tvoffset == 0) { if (flags & JIM_ERRMSG) { Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr); } return JIM_ERR; } - else { - *objPtrPtr = Jim_GetHashEntryVal(he); - return JIM_OK; - } + *objPtrPtr = dict->table[tvoffset]; + 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) +/* Return the key/value pairs array for the dictionary. Stores the length in *len + * + * Note that the point is to the internal table, so is only + * valid until the dict is next modified, and the result should + * not be freed. + * + * Returns NULL if the object can't be converted to a dictionary, or if the length is 0. + */ +Jim_Obj **Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, int *len) { + /* If it is a list with an even number of elements, no need to convert to dict first */ + if (Jim_IsList(dictPtr)) { + Jim_Obj **table; + JimListGetElements(interp, dictPtr, len, &table); + if (*len % 2 == 0) { + return table; + } + /* Otherwise fall through to get the standard error */ + } if (SetDictFromAny(interp, dictPtr) != JIM_OK) { - return JIM_ERR; + /* Make sure we can differentiate between an empty dict/list and bad length */ + *len = 1; + return NULL; } - *objPtrPtr = JimDictPairs(dictPtr, len); - - return JIM_OK; + *len = dictPtr->internalRep.dictValue->len; + return dictPtr->internalRep.dictValue->table; } - /* 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) @@ -7465,7 +7893,7 @@ } else { char buf[JIM_INTEGER_SPACE + 1]; - if (objPtr->internalRep.intValue >= 0) { + if (objPtr->internalRep.intValue >= 0 || objPtr->internalRep.intValue == -INT_MAX) { sprintf(buf, "%d", objPtr->internalRep.intValue); } else { @@ -7478,9 +7906,12 @@ static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr) { - int idx, end = 0; + jim_wide idx; + int end = 0; const char *str; - char *endptr; + Jim_Obj *exprObj = objPtr; + + JimPanic((objPtr->refCount == 0, "SetIndexFromAny() called with zero refcount object")); /* Get the string representation */ str = Jim_String(objPtr); @@ -7490,33 +7921,33 @@ end = 1; str += 3; idx = 0; - } - else { - idx = jim_strtol(str, &endptr); + switch (*str) { + case '\0': + exprObj = NULL; + break; - if (endptr == str) { - goto badindex; + case '-': + case '+': + /* Create a temp object here for evaluation, but this only happens + * once unless the index object shimmers since the result is kept + */ + exprObj = Jim_NewStringObj(interp, str, -1); + break; + + default: + goto badindex; } - str = endptr; } - - /* Now str may include or + or - */ - if (*str == '+' || *str == '-') { - int sign = (*str == '+' ? 1 : -1); - - idx += sign * jim_strtol(++str, &endptr); - if (str == endptr || *endptr) { + if (exprObj) { + int ret; + Jim_IncrRefCount(exprObj); + ret = Jim_GetWideExpr(interp, exprObj, &idx); + Jim_DecrRefCount(interp, exprObj); + if (ret != JIM_OK) { goto badindex; } - str = endptr; - } - /* The only thing left should be spaces */ - while (isspace(UCHAR(*str))) { - str++; - } - if (*str) { - goto badindex; } + if (end) { if (idx > 0) { idx = INT_MAX; @@ -7538,7 +7969,7 @@ badindex: Jim_SetResultFormatted(interp, - "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr); + "bad index \"%#s\": must be intexpr or end?[+-]intexpr?", objPtr); return JIM_ERR; } @@ -7672,15 +8103,19 @@ JIM_EXPROP_STRNE, JIM_EXPROP_STRIN, JIM_EXPROP_STRNI, + JIM_EXPROP_STRLT, + JIM_EXPROP_STRGT, + JIM_EXPROP_STRLE, + JIM_EXPROP_STRGE, /* Unary operators (numbers) */ - JIM_EXPROP_NOT, /* 47 */ + JIM_EXPROP_NOT, /* 51 */ JIM_EXPROP_BITNOT, JIM_EXPROP_UNARYMINUS, JIM_EXPROP_UNARYPLUS, /* Functions */ - JIM_EXPROP_FUNC_INT, /* 51 */ + JIM_EXPROP_FUNC_INT, /* 55 */ JIM_EXPROP_FUNC_WIDE, JIM_EXPROP_FUNC_ABS, JIM_EXPROP_FUNC_DOUBLE, @@ -7689,7 +8124,7 @@ JIM_EXPROP_FUNC_SRAND, /* math functions from libm */ - JIM_EXPROP_FUNC_SIN, /* 65 */ + JIM_EXPROP_FUNC_SIN, /* 69 */ JIM_EXPROP_FUNC_COS, JIM_EXPROP_FUNC_TAN, JIM_EXPROP_FUNC_ASIN, @@ -7740,7 +8175,7 @@ static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node) { int intresult = 1; - int rc; + int rc, bA = 0; double dA, dC = 0; jim_wide wA, wC = 0; Jim_Obj *A; @@ -7807,6 +8242,15 @@ abort(); } } + else if ((rc = Jim_GetBoolean(interp, A, &bA)) == JIM_OK) { + switch (node->type) { + case JIM_EXPROP_NOT: + wC = !bA; + break; + default: + abort(); + } + } if (rc == JIM_OK) { if (intresult) { @@ -7827,7 +8271,7 @@ unsigned long x; JimRandomBytes(interp, &x, sizeof(x)); - return (double)x / (unsigned long)~0; + return (double)x / (double)~0UL; } static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprNode *node) @@ -8252,7 +8696,7 @@ { Jim_Obj *A, *B; jim_wide wC; - int rc; + int comp, rc; if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) { return rc; @@ -8270,6 +8714,21 @@ wC = !wC; } break; + case JIM_EXPROP_STRLT: + case JIM_EXPROP_STRGT: + case JIM_EXPROP_STRLE: + case JIM_EXPROP_STRGE: + comp = Jim_StringCompareObj(interp, A, B, 0); + if (node->type == JIM_EXPROP_STRLT) { + wC = comp == -1; + } else if (node->type == JIM_EXPROP_STRGT) { + wC = comp == 1; + } else if (node->type == JIM_EXPROP_STRLE) { + wC = comp == -1 || comp == 0; + } else /* JIM_EXPROP_STRGE */ { + wC = comp == 0 || comp == 1; + } + break; case JIM_EXPROP_STRIN: wC = JimSearchList(interp, B, A); break; @@ -8415,6 +8874,13 @@ OPRINIT("in", 55, 2, JimExprOpStrBin), OPRINIT("ni", 55, 2, JimExprOpStrBin), + /* Precedence must be higher than ==, !=, eq, ne but lower than + <, >, <=, >= */ + OPRINIT("lt", 75, 2, JimExprOpStrBin), + OPRINIT("gt", 75, 2, JimExprOpStrBin), + OPRINIT("le", 75, 2, JimExprOpStrBin), + OPRINIT("ge", 75, 2, JimExprOpStrBin), + OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC), OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC), OPRINIT_ATTR(" -", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC), @@ -8460,13 +8926,22 @@ static int JimParseExpression(struct JimParserCtx *pc) { - /* Discard spaces and quoted newline */ - while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) { - if (*pc->p == '\n') { - pc->linenr++; + while (1) { + /* Discard spaces and quoted newline */ + while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) { + if (*pc->p == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; } - pc->p++; - pc->len--; + /* Discard comments */ + if (*pc->p == '#') { + JimParseComment(pc); + /* Go back to discarding white space */ + continue; + } + break; } /* Common case */ @@ -8593,17 +9068,11 @@ static int JimParseExprBoolean(struct JimParserCtx *pc) { - const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL }; - const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 }; int i; - - for (i = 0; booleans[i]; i++) { - const char *boolean = booleans[i]; - int length = lengths[i]; - - if (strncmp(boolean, pc->p, length) == 0) { - pc->p += length; - pc->len -= length; + for (i = 0; i < sizeof(jim_true_false_strings) / sizeof(*jim_true_false_strings); i++) { + if (strncmp(pc->p, jim_true_false_strings[i], jim_true_false_lens[i]) == 0) { + pc->p += jim_true_false_lens[i]; + pc->len -= jim_true_false_lens[i]; pc->tend = pc->p - 1; pc->tt = JIM_TT_EXPR_BOOLEAN; return JIM_OK; @@ -8703,7 +9172,7 @@ FreeExprInternalRep, DupExprInternalRep, NULL, - JIM_TYPE_REFERENCES, + JIM_TYPE_NONE, }; /* expr tree structure */ @@ -8809,8 +9278,7 @@ * * 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY. */ -static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms) -{ +static int ExprTreeBuildTree(Jim_Interp *interp, struct ExprBuilder *builder, int precedence, int flags, int exp_numterms) { int rc; struct JimExprNode *node; /* Calculate the stack length expected after pushing the number of expected terms */ @@ -9067,7 +9535,7 @@ builder.exprObjPtr = exprObjPtr; builder.fileNameObj = fileNameObj; /* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/ - builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1)); + builder.nodes = Jim_Alloc(sizeof(struct JimExprNode) * (tokenlist->count - 1)); memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1)); builder.next = builder.nodes; Jim_InitStack(&builder.stack); @@ -9262,6 +9730,9 @@ return JIM_ERR; case JIM_TT_ESC: + if (interp->safeexpr) { + return JIM_ERR; + } if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) { Jim_SetResult(interp, objPtr); return JIM_OK; @@ -9269,6 +9740,9 @@ return JIM_ERR; case JIM_TT_CMD: + if (interp->safeexpr) { + return JIM_ERR; + } return Jim_EvalObj(interp, node->objPtr); default: @@ -9301,9 +9775,11 @@ struct ExprTree *expr; int retcode = JIM_OK; + Jim_IncrRefCount(exprObjPtr); /* Make sure it's shared. */ expr = JimGetExpression(interp, exprObjPtr); if (!expr) { - return JIM_ERR; /* error in expression. */ + retcode = JIM_ERR; + goto done; } #ifdef JIM_OPTIMIZATION @@ -9319,7 +9795,7 @@ * $a != CONST, $a != $b * $a == CONST, $a == $b */ - { + if (!interp->safeexpr) { Jim_Obj *objPtr; /* STEP 1 -- Check if there are the conditions to run the specialized @@ -9330,7 +9806,7 @@ objPtr = JimExprIntValOrVar(interp, expr->expr); if (objPtr) { Jim_SetResult(interp, objPtr); - return JIM_OK; + goto done; } break; @@ -9340,7 +9816,7 @@ if (objPtr && JimIsWide(objPtr)) { Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj); - return JIM_OK; + goto done; } } break; @@ -9376,7 +9852,7 @@ goto noopt; } Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj); - return JIM_OK; + goto done; } } break; @@ -9386,14 +9862,21 @@ #endif /* In order to avoid the internal repr being freed due to - * shimmering of the exprObjPtr's object, we make the internal rep - * shared. */ + * shimmering of the exprObjPtr's object, we increment the use count + * and keep our own pointer outside the object. + */ expr->inUse++; /* Evaluate with the recursive expr engine */ retcode = JimExprEvalTermNode(interp, expr->expr); - expr->inUse--; + /* Now transfer ownership of expr back into the object in case it shimmered away */ + Jim_FreeIntRep(interp, exprObjPtr); + exprObjPtr->typePtr = &exprObjType; + Jim_SetIntRepPtr(exprObjPtr, expr); + +done: + Jim_DecrRefCount(interp, exprObjPtr); return retcode; } @@ -9717,7 +10200,7 @@ break; /* EOS via WS if unspecified */ n = utf8_tounicode(str, &c); - if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN)) + if (sdescr && !JimCharsetMatch(sdescr, strlen(sdescr), c, JIM_CHARSET_SCAN)) break; while (n--) *p++ = *str++; @@ -9732,7 +10215,7 @@ * returned of -1 in case of no conversion tool place and string was * already scanned thru */ -static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen, +static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int str_bytelen, ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr) { const char *tok; @@ -9747,17 +10230,17 @@ if (descr->prefix) { /* There was a prefix given before the conversion, skip it and adjust * the string-to-be-parsed accordingly */ - for (i = 0; pos < strLen && descr->prefix[i]; ++i) { + for (i = 0; pos < str_bytelen && descr->prefix[i]; ++i) { /* If prefix require, skip WS */ if (isspace(UCHAR(descr->prefix[i]))) - while (pos < strLen && isspace(UCHAR(str[pos]))) + while (pos < str_bytelen && isspace(UCHAR(str[pos]))) ++pos; else if (descr->prefix[i] != str[pos]) break; /* Prefix do not match here, leave the loop */ else ++pos; /* Prefix matched so far, next round */ } - if (pos >= strLen) { + if (pos >= str_bytelen) { return -1; /* All of str consumed: EOF condition */ } else if (descr->prefix[i] != 0) @@ -9767,6 +10250,7 @@ if (descr->type != 'c' && descr->type != '[' && descr->type != 'n') while (isspace(UCHAR(str[pos]))) ++pos; + /* Determine how much skipped/scanned so far */ scanned = pos - anchor; @@ -9775,22 +10259,22 @@ /* Return pseudo conversion means: how much scanned so far? */ *valObjPtr = Jim_NewIntObj(interp, anchor + scanned); } - else if (pos >= strLen) { + else if (pos >= str_bytelen) { /* Cannot scan anything, as str is totally consumed */ return -1; } else if (descr->type == 'c') { - int c; - scanned += utf8_tounicode(&str[pos], &c); - *valObjPtr = Jim_NewIntObj(interp, c); - return scanned; + int c; + scanned += utf8_tounicode(&str[pos], &c); + *valObjPtr = Jim_NewIntObj(interp, c); + return scanned; } else { /* Processing of conversions follows ... */ if (descr->width > 0) { /* Do not try to scan as fas as possible but only the given width. * To ensure this, we copy the part that should be scanned. */ - size_t sLen = utf8_strlen(&str[pos], strLen - pos); + size_t sLen = utf8_strlen(&str[pos], str_bytelen - pos); size_t tLen = descr->width > sLen ? sLen : descr->width; tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen); @@ -9880,7 +10364,7 @@ size_t i, pos; int scanned = 1; const char *str = Jim_String(strObjPtr); - int strLen = Jim_Utf8Length(interp, strObjPtr); + int str_bytelen = Jim_Length(strObjPtr); Jim_Obj *resultList = 0; Jim_Obj **resultVec = 0; int resultc; @@ -9917,7 +10401,7 @@ continue; /* As long as any conversion could be done, we will proceed */ if (scanned > 0) - scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value); + scanned = ScanOneEntry(interp, str, pos, str_bytelen, fmtObj, i, &value); /* In case our first try results in EOF, we will leave */ if (scanned == -1 && i == 0) goto eof; @@ -10045,7 +10529,7 @@ return JIM_ERR; } if (argc == 3) { - if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK) + if (Jim_GetWideExpr(interp, argv[2], &increment) != JIM_OK) return JIM_ERR; } intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED); @@ -10086,6 +10570,45 @@ #define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */ #define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */ +static int JimTraceCallback(Jim_Interp *interp, const char *type, int argc, Jim_Obj *const *argv) +{ + JimPanic((interp->traceCmdObj == NULL, "xtrace invoked with no object")); + + int ret; + Jim_Obj *nargv[7]; + Jim_Obj *traceCmdObj = interp->traceCmdObj; + Jim_Obj *resultObj = Jim_GetResult(interp); + /* Where were we called from? */ + ScriptObj *script = JimGetScript(interp, interp->currentScriptObj); + + nargv[0] = traceCmdObj; + nargv[1] = Jim_NewStringObj(interp, type, -1); + nargv[2] = script->fileNameObj; + nargv[3] = Jim_NewIntObj(interp, script->linenr); + nargv[4] = resultObj; + nargv[5] = argv[0]; + nargv[6] = Jim_NewListObj(interp, argv + 1, argc - 1); + + /* Remove the trace while executing the trace callback */ + interp->traceCmdObj = NULL; + /* Invoke the callback */ + Jim_IncrRefCount(resultObj); + ret = Jim_EvalObjVector(interp, 7, nargv); + Jim_DecrRefCount(interp, resultObj); + + if (ret == JIM_OK || ret == JIM_RETURN) { + /* Reinstall the trace callback */ + interp->traceCmdObj = traceCmdObj; + Jim_SetEmptyResult(interp); + ret = JIM_OK; + } + else { + /* No more tracing */ + Jim_DecrRefCount(interp, traceCmdObj); + } + return ret; +} + /* Handle calls to the [unknown] command */ static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { @@ -10120,6 +10643,7 @@ int retcode; Jim_Cmd *cmdPtr; void *prevPrivData; + Jim_Obj *tailcallObj = NULL; #if 0 printf("invoke"); @@ -10130,18 +10654,11 @@ printf("\n"); #endif - if (interp->framePtr->tailcallCmd) { - /* Special tailcall command was pre-resolved */ - cmdPtr = interp->framePtr->tailcallCmd; - interp->framePtr->tailcallCmd = NULL; - } - else { - cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG); - if (cmdPtr == NULL) { - return JimUnknown(interp, objc, objv); - } - JimIncrCmdRefCount(cmdPtr); + cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG); + if (cmdPtr == NULL) { + return JimUnknown(interp, objc, objv); } + JimIncrCmdRefCount(cmdPtr); if (interp->evalDepth == interp->maxEvalDepth) { Jim_SetResultString(interp, "Infinite eval recursion", -1); @@ -10151,21 +10668,60 @@ interp->evalDepth++; prevPrivData = interp->cmdPrivData; - /* Call it -- Make sure result is an empty object. */ - Jim_SetEmptyResult(interp); - if (cmdPtr->isproc) { - retcode = JimCallProcedure(interp, cmdPtr, objc, objv); +tailcall: + + if (!interp->traceCmdObj || + (retcode = JimTraceCallback(interp, "cmd", objc, objv)) == JIM_OK) { + /* Call it -- Make sure result is an empty object. */ + Jim_SetEmptyResult(interp); + if (cmdPtr->isproc) { + retcode = JimCallProcedure(interp, cmdPtr, objc, objv); + } + else { + interp->cmdPrivData = cmdPtr->u.native.privData; + retcode = cmdPtr->u.native.cmdProc(interp, objc, objv); + } } - else { - interp->cmdPrivData = cmdPtr->u.native.privData; - retcode = cmdPtr->u.native.cmdProc(interp, objc, objv); + + if (tailcallObj) { + /* clean up previous tailcall if we were invoking one */ + Jim_DecrRefCount(interp, tailcallObj); + tailcallObj = NULL; + } + + /* If a tailcall is returned for this frame, loop to invoke the new command */ + if (retcode == JIM_EVAL && interp->framePtr->tailcallObj) { + JimDecrCmdRefCount(interp, cmdPtr); + + /* Replace the current command with the new tailcall command */ + cmdPtr = interp->framePtr->tailcallCmd; + interp->framePtr->tailcallCmd = NULL; + tailcallObj = interp->framePtr->tailcallObj; + interp->framePtr->tailcallObj = NULL; + /* We can access the internal rep here because the object can only + * be constructed by the tailcall command + */ + objc = tailcallObj->internalRep.listValue.len; + objv = tailcallObj->internalRep.listValue.ele; + goto tailcall; } + interp->cmdPrivData = prevPrivData; interp->evalDepth--; out: JimDecrCmdRefCount(interp, cmdPtr); + if (interp->framePtr->tailcallObj) { + /* We might have skipped invoking a tailcall, perhaps because of an error + * in defer handling so cleanup now + */ + JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd); + Jim_DecrRefCount(interp, interp->framePtr->tailcallObj); + interp->framePtr->tailcallCmd = NULL; + interp->framePtr->tailcallObj = NULL; + } + return retcode; } @@ -10708,7 +11264,7 @@ } else { /* We have plain args */ - Jim_AppendString(interp, argmsg, "?arg...?", -1); + Jim_AppendString(interp, argmsg, "?arg ...?", -1); } } else { @@ -10859,8 +11415,11 @@ } } - /* Eval the body */ - retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr); + if (interp->traceCmdObj == NULL || + (retcode = JimTraceCallback(interp, "proc", argc, argv)) == JIM_OK) { + /* Eval the body */ + retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr); + } badargset: @@ -10869,32 +11428,6 @@ interp->framePtr = interp->framePtr->parent; JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE); - /* Now chain any tailcalls in the parent frame */ - if (interp->framePtr->tailcallObj) { - do { - Jim_Obj *tailcallObj = interp->framePtr->tailcallObj; - - interp->framePtr->tailcallObj = NULL; - - if (retcode == JIM_EVAL) { - retcode = Jim_EvalObjList(interp, tailcallObj); - if (retcode == JIM_RETURN) { - /* If the result of the tailcall is 'return', push - * it up to the caller - */ - interp->returnLevel++; - } - } - Jim_DecrRefCount(interp, tailcallObj); - } while (interp->framePtr->tailcallObj); - - /* If the tailcall chain finished early, may need to manually discard the command */ - if (interp->framePtr->tailcallCmd) { - JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd); - interp->framePtr->tailcallCmd = NULL; - } - } - /* Handle the JIM_RETURN return code */ if (retcode == JIM_RETURN) { if (--interp->returnLevel <= 0) { @@ -11194,13 +11727,13 @@ * May add the key and/or value to the list. */ typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, - Jim_HashEntry *he, int type); + Jim_Obj *keyObjPtr, void *value, Jim_Obj *patternObjPtr, int type); #define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL) /** - * For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL), - * invoke the callback to add entries to a list. + * For each key of the hash table 'ht' with object keys that + * matches the glob pattern (all if NULL), invoke the callback to add entries to a list. * Returns the list. */ static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr, @@ -11211,18 +11744,18 @@ /* Check for the non-pattern case. We can do this much more efficiently. */ if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) { - he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr)); + he = Jim_FindHashEntry(ht, patternObjPtr); if (he) { - callback(interp, listObjPtr, he, type); + callback(interp, listObjPtr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he), + patternObjPtr, type); } } else { Jim_HashTableIterator htiter; JimInitHashTableIterator(ht, &htiter); while ((he = Jim_NextHashEntry(&htiter)) != NULL) { - if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) { - callback(interp, listObjPtr, he, type); - } + callback(interp, listObjPtr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he), + patternObjPtr, type); } } return listObjPtr; @@ -11237,26 +11770,32 @@ * Adds matching command names (procs, channels) to the list. */ static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, - Jim_HashEntry *he, int type) + Jim_Obj *keyObj, void *value, Jim_Obj *patternObj, int type) { - Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he); - Jim_Obj *objPtr; + Jim_Cmd *cmdPtr = (Jim_Cmd *)value; if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) { /* not a proc */ return; } - objPtr = Jim_NewStringObj(interp, he->key, -1); - Jim_IncrRefCount(objPtr); + Jim_IncrRefCount(keyObj); - if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) { - Jim_ListAppendElement(interp, listObjPtr, objPtr); + if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, keyObj)) { + int match = 1; + if (patternObj) { + int plen, slen; + const char *pattern = Jim_GetStringNoQualifier(patternObj, &plen); + const char *str = Jim_GetStringNoQualifier(keyObj, &slen); + match = JimGlobMatch(pattern, plen, str, slen, 0); + } + if (match) { + Jim_ListAppendElement(interp, listObjPtr, keyObj); + } } - Jim_DecrRefCount(interp, objPtr); + Jim_DecrRefCount(interp, keyObj); } -/* type is JIM_CMDLIST_xxx */ static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type) { return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type); @@ -11266,6 +11805,7 @@ #define JIM_VARLIST_GLOBALS 0 #define JIM_VARLIST_LOCALS 1 #define JIM_VARLIST_VARS 2 +#define JIM_VARLIST_MASK 0x000f #define JIM_VARLIST_VALUES 0x1000 @@ -11273,14 +11813,16 @@ * Adds matching variable names to the list. */ static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, - Jim_HashEntry *he, int type) + Jim_Obj *keyObj, void *value, Jim_Obj *patternObj, int type) { - Jim_Var *varPtr = Jim_GetHashEntryVal(he); + Jim_Var *varPtr = (Jim_Var *)value; - if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) { - Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1)); - if (type & JIM_VARLIST_VALUES) { - Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr); + if ((type & JIM_VARLIST_MASK) != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) { + if (patternObj == NULL || Jim_StringMatchObj(interp, patternObj, keyObj, 0)) { + Jim_ListAppendElement(interp, listObjPtr, keyObj); + if (type & JIM_VARLIST_VALUES) { + Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr); + } } } } @@ -11289,13 +11831,14 @@ static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode) { if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) { - /* For [info locals], if we are at top level an emtpy list + /* For [info locals], if we are at top level an empty list * is returned. I don't agree, but we aim at compatibility (SS) */ return interp->emptyObj; } else { Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr; - return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode); + return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, + mode); } } @@ -11665,7 +12208,7 @@ /* Get the stop condition (must be a variable or integer) */ if (expr->expr->right->type == JIM_TT_EXPR_INT) { - if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) { + if (Jim_GetWideExpr(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) { goto evalstart; } } @@ -11772,19 +12315,28 @@ jim_wide incr = 1; Jim_Obj *bodyObjPtr; - if (argc != 5 && argc != 6) { - Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body"); + if (argc < 4 || argc > 6) { + Jim_WrongNumArgs(interp, 1, argv, "var ?first? limit ?incr? body"); return JIM_ERR; } - if (Jim_GetWide(interp, argv[2], &i) != JIM_OK || - Jim_GetWide(interp, argv[3], &limit) != JIM_OK || - (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) { - return JIM_ERR; + retval = Jim_GetWideExpr(interp, argv[2], &i); + if (argc > 4 && retval == JIM_OK) { + retval = Jim_GetWideExpr(interp, argv[3], &limit); + } + if (argc > 5 && retval == JIM_OK) { + Jim_GetWideExpr(interp, argv[4], &incr); + } + if (retval != JIM_OK) { + return retval; + } + if (argc == 4) { + limit = i; + i = 0; } - bodyObjPtr = (argc == 5) ? argv[4] : argv[5]; + bodyObjPtr = argv[argc - 1]; - retval = Jim_SetVariable(interp, argv[1], argv[2]); + retval = Jim_SetVariable(interp, argv[1], Jim_NewIntObj(interp, i)); while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) { retval = Jim_EvalObj(interp, bodyObjPtr); @@ -12065,19 +12617,24 @@ } -/* Returns 1 if match, 0 if no match or - on error (e.g. -JIM_ERR, -JIM_BREAK)*/ +/* Returns 1 if match, 0 if no match or - on error (e.g. -JIM_ERR, -JIM_BREAK) + * flags may contain JIM_NOCASE and/or JIM_OPT_END + */ int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj, - Jim_Obj *stringObj, int nocase) + Jim_Obj *stringObj, int flags) { - Jim_Obj *parms[4]; + Jim_Obj *parms[5]; int argc = 0; long eq; int rc; parms[argc++] = commandObj; - if (nocase) { + if (flags & JIM_NOCASE) { parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1); } + if (flags & JIM_OPT_END) { + parms[argc++] = Jim_NewStringObj(interp, "--", -1); + } parms[argc++] = patternObj; parms[argc++] = stringObj; @@ -12095,6 +12652,7 @@ { enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD }; int matchOpt = SWITCH_EXACT, opt = 1, patCount, i; + int match_flags = 0; Jim_Obj *command = NULL, *scriptObj = NULL, *strObj; Jim_Obj **caseList; @@ -12117,8 +12675,10 @@ matchOpt = SWITCH_EXACT; else if (strncmp(option, "-glob", 2) == 0) matchOpt = SWITCH_GLOB; - else if (strncmp(option, "-regexp", 2) == 0) + else if (strncmp(option, "-regexp", 2) == 0) { matchOpt = SWITCH_RE; + match_flags |= JIM_OPT_END; + } else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD; if ((argc - opt) < 2) @@ -12161,7 +12721,7 @@ command = Jim_NewStringObj(interp, "regexp", -1); /* Fall thru intentionally */ case SWITCH_CMD:{ - int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0); + int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, match_flags); /* After the execution of a command we need to * make sure to reconvert the object into a list @@ -12209,35 +12769,24 @@ /* [lindex] */ static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - Jim_Obj *objPtr, *listObjPtr; - int i; - int idx; + Jim_Obj *objPtr; + int ret; if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?"); - return JIM_ERR; - } - objPtr = argv[1]; - Jim_IncrRefCount(objPtr); - for (i = 2; i < argc; i++) { - listObjPtr = objPtr; - if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) { - Jim_DecrRefCount(interp, listObjPtr); - return JIM_ERR; - } - if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) { - /* Returns an empty object if the index - * is out of range. */ - Jim_DecrRefCount(interp, listObjPtr); - Jim_SetEmptyResult(interp); - return JIM_OK; - } - Jim_IncrRefCount(objPtr); - Jim_DecrRefCount(interp, listObjPtr); + Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?"); + return JIM_ERR; } - Jim_SetResult(interp, objPtr); - Jim_DecrRefCount(interp, objPtr); - return JIM_OK; + ret = Jim_ListIndices(interp, argv[1], argv + 2, argc - 2, &objPtr, JIM_NONE); + if (ret < 0) { + /* Returns an empty object if the index + * is out of range. */ + ret = JIM_OK; + Jim_SetEmptyResult(interp); + } + else if (ret == JIM_OK) { + Jim_SetResult(interp, objPtr); + } + return ret; } /* [llength] */ @@ -12256,15 +12805,14 @@ { static const char * const options[] = { "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command", - NULL + "-stride", "-index", NULL }; enum { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE, - OPT_COMMAND }; + OPT_COMMAND, OPT_STRIDE, OPT_INDEX }; int i; int opt_bool = 0; int opt_not = 0; - int opt_nocase = 0; int opt_all = 0; int opt_inline = 0; int opt_match = OPT_EXACT; @@ -12272,11 +12820,14 @@ int rc = JIM_OK; Jim_Obj *listObjPtr = NULL; Jim_Obj *commandObj = NULL; + Jim_Obj *indexObj = NULL; + int match_flags = 0; + long stride = 1; if (argc < 3) { wrongargs: Jim_WrongNumArgs(interp, 1, argv, - "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value"); + "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? ?-stride len? ?-index val? list value"); return JIM_ERR; } @@ -12295,7 +12846,7 @@ opt_not = 1; break; case OPT_NOCASE: - opt_nocase = 1; + match_flags |= JIM_NOCASE; break; case OPT_INLINE: opt_inline = 1; @@ -12304,6 +12855,10 @@ case OPT_ALL: opt_all = 1; break; + case OPT_REGEXP: + opt_match = option; + match_flags |= JIM_OPT_END; + break; case OPT_COMMAND: if (i >= argc - 2) { goto wrongargs; @@ -12312,14 +12867,41 @@ /* fallthru */ case OPT_EXACT: case OPT_GLOB: - case OPT_REGEXP: opt_match = option; break; + case OPT_INDEX: + if (i >= argc - 2) { + goto wrongargs; + } + indexObj = argv[++i]; + break; + case OPT_STRIDE: + if (i >= argc - 2) { + goto wrongargs; + } + if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) { + return JIM_ERR; + } + if (stride < 1) { + Jim_SetResultString(interp, "stride length must be at least 1", -1); + return JIM_ERR; + } + break; } } + argc -= i; + if (argc < 2) { + goto wrongargs; + } argv += i; + listlen = Jim_ListLength(interp, argv[0]); + if (listlen % stride) { + Jim_SetResultString(interp, "list size must be a multiple of the stride length", -1); + return JIM_ERR; + } + if (opt_all) { listObjPtr = Jim_NewListObj(interp, NULL, 0); } @@ -12330,40 +12912,64 @@ Jim_IncrRefCount(commandObj); } - listlen = Jim_ListLength(interp, argv[0]); - for (i = 0; i < listlen; i++) { + for (i = 0; i < listlen; i += stride) { int eq = 0; - Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i); + Jim_Obj *searchListObj; + Jim_Obj *objPtr; + int offset; + + if (indexObj) { + int indexlen = Jim_ListLength(interp, indexObj); + if (stride == 1) { + searchListObj = Jim_ListGetIndex(interp, argv[0], i); + } + else { + searchListObj = Jim_NewListObj(interp, argv[0]->internalRep.listValue.ele + i, stride); + } + Jim_IncrRefCount(searchListObj); + rc = Jim_ListIndices(interp, searchListObj, indexObj->internalRep.listValue.ele, indexlen, &objPtr, JIM_ERRMSG); + if (rc != JIM_OK) { + Jim_DecrRefCount(interp, searchListObj); + rc = JIM_ERR; + goto done; + } + /* now indexObj is the object to compare */ + offset = 0; + } + else { + /* No -index, so we have an implicit {0} as indexObj */ + searchListObj = argv[0]; + offset = i; + objPtr = Jim_ListGetIndex(interp, searchListObj, i); + Jim_IncrRefCount(searchListObj); + } + /* At this point objPtr represents the object to search against and + * searchListObj represents the list we search in (offset .. offset + stride - 1) + * both need to have reference counts decremented when done + */ switch (opt_match) { case OPT_EXACT: - eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0; + eq = Jim_StringCompareObj(interp, argv[1], objPtr, match_flags) == 0; break; case OPT_GLOB: - eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase); + eq = Jim_StringMatchObj(interp, argv[1], objPtr, match_flags); break; case OPT_REGEXP: case OPT_COMMAND: - eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase); + eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, match_flags); if (eq < 0) { - if (listObjPtr) { - Jim_FreeNewObj(interp, listObjPtr); - } + Jim_DecrRefCount(interp, searchListObj); rc = JIM_ERR; goto done; } break; } - /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */ - if (!eq && opt_bool && opt_not && !opt_all) { - continue; - } - + /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */ if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) { - /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */ Jim_Obj *resultObj; if (opt_bool) { @@ -12372,22 +12978,38 @@ else if (!opt_inline) { resultObj = Jim_NewIntObj(interp, i); } - else { + else if (stride == 1) { resultObj = objPtr; } + else if (opt_all) { + /* Add the entire sublist directly for -all -stride > 1 */ + ListInsertElements(listObjPtr, -1, stride, + searchListObj->internalRep.listValue.ele + offset); + /* Not necessary, but some compilers can't figure that out */ + resultObj = NULL; + } + else { + resultObj = Jim_NewListObj(interp, searchListObj->internalRep.listValue.ele + offset, stride); + } if (opt_all) { - Jim_ListAppendElement(interp, listObjPtr, resultObj); + /* The stride > 1 case has already been handled above */ + if (stride == 1) { + Jim_ListAppendElement(interp, listObjPtr, resultObj); + } } else { Jim_SetResult(interp, resultObj); + Jim_DecrRefCount(interp, searchListObj); goto done; } } + Jim_DecrRefCount(interp, searchListObj); } if (opt_all) { Jim_SetResult(interp, listObjPtr); + listObjPtr = NULL; } else { /* No match */ @@ -12400,6 +13022,9 @@ } done: + if (listObjPtr) { + Jim_FreeNewObj(interp, listObjPtr); + } if (commandObj) { Jim_DecrRefCount(interp, commandObj); } @@ -12519,7 +13144,7 @@ static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { if (argc < 3) { - Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal"); + Jim_WrongNumArgs(interp, 1, argv, "listVar ?index ...? value"); return JIM_ERR; } else if (argc == 3) { @@ -12536,25 +13161,30 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[]) { static const char * const options[] = { - "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL + "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", + "-stride", NULL + }; + enum { + OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE, + OPT_STRIDE }; - enum - { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE }; Jim_Obj *resObj; int i; int retCode; int shared; + long stride = 1; struct lsort_info info; if (argc < 2) { +wrongargs: Jim_WrongNumArgs(interp, 1, argv, "?options? list"); return JIM_ERR; } info.type = JIM_LSORT_ASCII; info.order = 1; - info.indexed = 0; + info.indexc = 0; info.unique = 0; info.command = NULL; info.interp = interp; @@ -12596,28 +13226,72 @@ info.command = argv[i + 1]; i++; break; + case OPT_STRIDE: + if (i >= argc - 2) { + goto wrongargs; + } + if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) { + return JIM_ERR; + } + if (stride < 2) { + Jim_SetResultString(interp, "stride length must be at least 2", -1); + return JIM_ERR; + } + break; case OPT_INDEX: if (i >= (argc - 2)) { +badindex: Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1); return JIM_ERR; } - if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) { - return JIM_ERR; + JimListGetElements(interp, argv[i + 1], &info.indexc, &info.indexv); + if (info.indexc == 0) { + goto badindex; } - info.indexed = 1; i++; break; } } resObj = argv[argc - 1]; - if ((shared = Jim_IsShared(resObj))) - resObj = Jim_DuplicateObj(interp, resObj); - retCode = ListSortElements(interp, resObj, &info); - if (retCode == JIM_OK) { - Jim_SetResult(interp, resObj); + if (stride > 1) { + Jim_Obj *tmpListObj; + Jim_Obj **elements; + int listlen; + int i; + + JimListGetElements(interp, resObj, &listlen, &elements); + if (listlen % stride) { + Jim_SetResultString(interp, "list size must be a multiple of the stride length", -1); + return JIM_ERR; + } + /* Need to create a new list of lists for sorting */ + tmpListObj = Jim_NewListObj(interp, NULL, 0); + Jim_IncrRefCount(tmpListObj); + for (i = 0; i < listlen; i += stride) { + Jim_ListAppendElement(interp, tmpListObj, Jim_NewListObj(interp, elements + i, stride)); + } + retCode = ListSortElements(interp, tmpListObj, &info); + if (retCode == JIM_OK) { + resObj = Jim_NewListObj(interp, NULL, 0); + /* Now we need to unpack the result back into a flat list */ + for (i = 0; i < listlen; i += stride) { + Jim_ListAppendList(interp, resObj, Jim_ListGetIndex(interp, tmpListObj, i / stride)); + } + Jim_SetResult(interp, resObj); + } + Jim_DecrRefCount(interp, tmpListObj); } - else if (shared) { - Jim_FreeNewObj(interp, resObj); + else { + if ((shared = Jim_IsShared(resObj))) { + resObj = Jim_DuplicateObj(interp, resObj); + } + retCode = ListSortElements(interp, resObj, &info); + if (retCode == JIM_OK) { + Jim_SetResult(interp, resObj); + } + else if (shared) { + Jim_FreeNewObj(interp, resObj); + } } return retCode; } @@ -12691,9 +13365,9 @@ #endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */ /* [debug] */ +#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP) static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { -#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP) static const char * const options[] = { "refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen", "exprbc", "show", @@ -12749,6 +13423,11 @@ else if (option == OPT_OBJECTS) { Jim_Obj *objPtr, *listObjPtr, *subListObjPtr; + if (argc != 2) { + Jim_WrongNumArgs(interp, 2, argv, ""); + return JIM_ERR; + } + /* Count the number of live objects. */ objPtr = interp->liveList; listObjPtr = Jim_NewListObj(interp, NULL, 0); @@ -12795,13 +13474,17 @@ #else charlen = len; #endif - printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2])); - printf("chars (%d): <<%s>>\n", charlen, s); - printf("bytes (%d):", len); + char buf[256]; + snprintf(buf, sizeof(buf), "refcount: %d, type: %s\n" + "chars (%d):", + argv[2]->refCount, JimObjTypeName(argv[2]), charlen); + Jim_SetResultFormatted(interp, "%s <<%s>>\n", buf, s); + snprintf(buf, sizeof(buf), "bytes (%d):", len); + Jim_AppendString(interp, Jim_GetResult(interp), buf, -1); while (len--) { - printf(" %02x", (unsigned char)*s++); + snprintf(buf, sizeof(buf), " %02x", (unsigned char)*s++); + Jim_AppendString(interp, Jim_GetResult(interp), buf, -1); } - printf("\n"); return JIM_OK; } else if (option == OPT_SCRIPTLEN) { @@ -12849,12 +13532,8 @@ return JIM_ERR; } /* unreached */ -#endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */ -#if !defined(JIM_DEBUG_COMMAND) - Jim_SetResultString(interp, "unsupported", -1); - return JIM_ERR; -#endif } +#endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */ /* [eval] */ static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) @@ -12933,6 +13612,12 @@ if (argc == 2) { retcode = Jim_EvalExpression(interp, argv[1]); } +#ifndef JIM_COMPAT + else { + Jim_WrongNumArgs(interp, 1, argv, "expression"); + retcode = JIM_ERR; + } +#else else if (argc > 2) { Jim_Obj *objPtr; @@ -12945,9 +13630,8 @@ Jim_WrongNumArgs(interp, 1, argv, "expression ?...?"); return JIM_ERR; } - if (retcode != JIM_OK) - return retcode; - return JIM_OK; +#endif + return retcode; } /* [break] */ @@ -13021,7 +13705,7 @@ if (i == argc - 1) { Jim_SetResult(interp, argv[i]); } - return JIM_RETURN; + return level == 0 ? returnCode : JIM_RETURN; } /* [tailcall] */ @@ -13079,7 +13763,6 @@ static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { Jim_Obj *prefixListObj; - const char *newname; if (argc < 3) { Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?"); @@ -13088,15 +13771,9 @@ prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2); Jim_IncrRefCount(prefixListObj); - newname = Jim_String(argv[1]); - if (newname[0] == ':' && newname[1] == ':') { - while (*++newname == ':') { - } - } - Jim_SetResult(interp, argv[1]); - return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete); + return Jim_CreateCommandObj(interp, argv[1], JimAliasCmd, prefixListObj, JimAliasCmdDelete); } /* [proc] */ @@ -13109,10 +13786,6 @@ return JIM_ERR; } - if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) { - return JIM_ERR; - } - if (argc == 4) { cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL); } @@ -13122,15 +13795,12 @@ if (cmd) { /* Add the new command */ - Jim_Obj *qualifiedCmdNameObj; - const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj); - - JimCreateCommand(interp, cmdname, cmd); + Jim_Obj *nameObjPtr = JimQualifyName(interp, argv[1]); + JimCreateCommand(interp, nameObjPtr, cmd); /* Calculate and set the namespace for this proc */ - JimUpdateProcNamespace(interp, cmd, cmdname); - - JimFreeQualifiedName(interp, qualifiedCmdNameObj); + JimUpdateProcNamespace(interp, cmd, nameObjPtr); + Jim_DecrRefCount(interp, nameObjPtr); /* Unlike Tcl, set the name of the proc as the result */ Jim_SetResult(interp, argv[1]); @@ -13139,6 +13809,27 @@ return JIM_ERR; } +/* [xtrace] */ +static int Jim_XtraceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "callback"); + return JIM_ERR; + } + + if (interp->traceCmdObj) { + Jim_DecrRefCount(interp, interp->traceCmdObj); + interp->traceCmdObj = NULL; + } + + if (Jim_Length(argv[1])) { + /* Install the new execution trace callback */ + interp->traceCmdObj = argv[1]; + Jim_IncrRefCount(interp->traceCmdObj); + } + return JIM_OK; +} + /* [local] */ static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { @@ -13226,8 +13917,8 @@ if (len == 3) { #ifdef jim_ext_namespace - /* Need to canonicalise the given namespace. */ - nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2)); + /* Note that the namespace is always treated as global */ + nsObj = Jim_ListGetIndex(interp, argv[1], 2); #else Jim_SetResultString(interp, "namespaces not enabled", -1); return JIM_ERR; @@ -13353,7 +14044,7 @@ if (strLen >= kl && kl) { int rc; - rc = JimStringCompareLen(str, k, kl, nocase); + rc = JimStringCompareUtf8(str, kl, k, kl, nocase); if (rc == 0) { if (noMatchStart) { Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart); @@ -13487,12 +14178,19 @@ Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1])); } else { + const char *s1 = Jim_String(argv[0]); + int l1 = Jim_Utf8Length(interp, argv[0]); + const char *s2 = Jim_String(argv[1]); + int l2 = Jim_Utf8Length(interp, argv[1]); if (opt_length >= 0) { - n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case); - } - else { - n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case); + if (l1 > opt_length) { + l1 = opt_length; + } + if (l2 > opt_length) { + l2 = opt_length; + } } + n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case); Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0); } return JIM_OK; @@ -13581,7 +14279,7 @@ Jim_WrongNumArgs(interp, 2, argv, "string count"); return JIM_ERR; } - if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) { + if (Jim_GetWideExpr(interp, argv[3], &count) != JIM_OK) { return JIM_ERR; } objPtr = Jim_NewStringObj(interp, "", 0); @@ -13606,6 +14304,7 @@ str = Jim_GetString(argv[2], &len); buf = Jim_Alloc(len + 1); + assert(buf); p = buf + len; *p = 0; for (i = 0; i < len; ) { @@ -13633,9 +14332,7 @@ } str = Jim_String(argv[2]); len = Jim_Utf8Length(interp, argv[2]); - if (idx != INT_MIN && idx != INT_MAX) { - idx = JimRelToAbsIndex(len, idx); - } + idx = JimRelToAbsIndex(len, idx); if (idx < 0 || idx >= len || str == NULL) { Jim_SetResultString(interp, "", 0); } @@ -13669,6 +14366,9 @@ return JIM_ERR; } idx = JimRelToAbsIndex(l2, idx); + if (idx < 0) { + idx = 0; + } } else if (option == OPT_LAST) { idx = l2; @@ -13741,8 +14441,6 @@ { long i, count = 1; jim_wide start, elapsed; - char buf[60]; - const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration"; if (argc < 2) { Jim_WrongNumArgs(interp, 1, argv, "script ?count?"); @@ -13765,8 +14463,13 @@ } } elapsed = JimClock() - start; - sprintf(buf, fmt, count == 0 ? 0 : elapsed / count); - Jim_SetResultString(interp, buf, -1); + if (elapsed < count * 10) { + Jim_SetResult(interp, Jim_NewDoubleObj(interp, elapsed * 1.0 / count)); + } + else { + Jim_SetResultInt(interp, count == 0 ? 0 : elapsed / count); + } + Jim_AppendString(interp, Jim_GetResult(interp)," microseconds per iteration", -1); return JIM_OK; } @@ -13782,23 +14485,52 @@ if (argc == 2) { if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK) return JIM_ERR; + Jim_SetResult(interp, argv[1]); } interp->exitCode = exitCode; return JIM_EXIT; } -/* [catch] */ -static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +static int JimMatchReturnCodes(Jim_Interp *interp, Jim_Obj *retcodeListObj, int rc) +{ + int len = Jim_ListLength(interp, retcodeListObj); + int i; + for (i = 0; i < len; i++) { + int returncode; + if (Jim_GetReturnCode(interp, Jim_ListGetIndex(interp, retcodeListObj, i), &returncode) != JIM_OK) { + return JIM_ERR; + } + if (rc == returncode) { + return JIM_OK; + } + } + return -1; +} + +/* Implements both [try] and [catch] */ +static int JimCatchTryHelper(Jim_Interp *interp, int istry, int argc, Jim_Obj *const *argv) { + static const char * const wrongargs_catchtry[2] = { + "?-?no?code ... --? script ?resultVarName? ?optionVarName?", + "?-?no?code ... --? script ?on codes vars script? ... ?finally script?" + }; int exitCode = 0; int i; int sig = 0; + int ok; + Jim_Obj *finallyScriptObj = NULL; + Jim_Obj *msgVarObj = NULL; + Jim_Obj *optsVarObj = NULL; + Jim_Obj *onScriptObj = NULL; + int idx; /* Which return codes are ignored (passed through)? By default, only exit, eval and signal */ jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL); static const int max_ignore_code = sizeof(ignore_mask) * 8; - /* Reset the error code before catch. + JimPanic((istry != 0 && istry != 1, "wrong args to JimCatchTryHelper")); + + /* Reset the error code before catch/try. * Note that this is not strictly correct. */ Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1)); @@ -13844,14 +14576,13 @@ } } - argc -= i; - if (argc < 1 || argc > 3) { - wrongargs: - Jim_WrongNumArgs(interp, 1, argv, - "?-?no?code ... --? script ?resultVarName? ?optionVarName?"); + idx = i; + + if (argc - idx < 1) { +wrongargs: + Jim_WrongNumArgs(interp, 1, argv, wrongargs_catchtry[istry]); return JIM_ERR; } - argv += i; if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) { sig++; @@ -13863,15 +14594,67 @@ exitCode = JIM_SIGNAL; } else { - exitCode = Jim_EvalObj(interp, argv[0]); + exitCode = Jim_EvalObj(interp, argv[idx]); /* Don't want any caught error included in a later stack trace */ interp->errorFlag = 0; } interp->signal_level -= sig; + /* For try, we need to find both a matching return code and finally (if they exist) + * Set: finallyScriptObj + * onScriptObj + * msgVarObj + * optsVarObj + * Any of these can be NULL; + */ + idx++; + if (istry) { + while (idx < argc) { + if (Jim_CompareStringImmediate(interp, argv[idx], "on")) { + int ret; + if (idx + 4 > argc) { + goto wrongargs; + } + ret = JimMatchReturnCodes(interp, argv[idx + 1], exitCode); + if (ret > JIM_OK) { + goto wrongargs; + } + if (ret == JIM_OK) { + msgVarObj = Jim_ListGetIndex(interp, argv[idx + 2], 0); + optsVarObj = Jim_ListGetIndex(interp, argv[idx + 2], 1); + onScriptObj = argv[idx + 3]; + } + idx += 4; + } + else if (Jim_CompareStringImmediate(interp, argv[idx], "finally")) { + if (idx + 2 != argc) { + goto wrongargs; + } + finallyScriptObj = argv[idx + 1]; + idx += 2; + } + else { + goto wrongargs; + } + } + } + else { + if (argc - idx >= 1) { + msgVarObj = argv[idx]; + idx++; + if (argc - idx >= 1) { + optsVarObj = argv[idx]; + idx++; + } + } + } + /* Catch or pass through? Only the first 32/64 codes can be passed through */ if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) { /* Not caught, pass it up */ + if (finallyScriptObj) { + Jim_EvalObj(interp, finallyScriptObj); + } return exitCode; } @@ -13880,43 +14663,77 @@ if (interp->signal_set_result) { interp->signal_set_result(interp, interp->sigmask); } - else { + else if (!istry) { Jim_SetResultInt(interp, interp->sigmask); } interp->sigmask = 0; } - if (argc >= 2) { - if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) { - return JIM_ERR; + ok = 1; + if (msgVarObj && Jim_Length(msgVarObj)) { + if (Jim_SetVariable(interp, msgVarObj, Jim_GetResult(interp)) != JIM_OK) { + ok = 0; } - if (argc == 3) { - Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0); + } + if (ok && optsVarObj && Jim_Length(optsVarObj)) { + Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0); - Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1)); - Jim_ListAppendElement(interp, optListObj, - Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode)); - Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1)); - Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel)); - if (exitCode == JIM_ERR) { - Jim_Obj *errorCode; - Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo", - -1)); - Jim_ListAppendElement(interp, optListObj, interp->stackTrace); + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1)); + Jim_ListAppendElement(interp, optListObj, + Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode)); + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1)); + Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel)); + if (exitCode == JIM_ERR) { + Jim_Obj *errorCode; + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo", + -1)); + Jim_ListAppendElement(interp, optListObj, interp->stackTrace); - errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE); - if (errorCode) { - Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1)); - Jim_ListAppendElement(interp, optListObj, errorCode); - } - } - if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) { - return JIM_ERR; + errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE); + if (errorCode) { + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1)); + Jim_ListAppendElement(interp, optListObj, errorCode); } } + if (Jim_SetVariable(interp, optsVarObj, optListObj) != JIM_OK) { + ok = 0; + } } - Jim_SetResultInt(interp, exitCode); - return JIM_OK; + if (ok && onScriptObj) { + /* Execute the on script. Any return code replaces the original. */ + exitCode = Jim_EvalObj(interp, onScriptObj); + } + + if (finallyScriptObj) { + /* Execute the on script. If OK, restore previous resul/exitcode */ + Jim_Obj *prevResultObj = Jim_GetResult(interp); + Jim_IncrRefCount(prevResultObj); + int ret = Jim_EvalObj(interp, finallyScriptObj); + if (ret == JIM_OK) { + Jim_SetResult(interp, prevResultObj); + } + else { + exitCode = ret; + } + Jim_DecrRefCount(interp, prevResultObj); + } + if (!istry) { + Jim_SetResultInt(interp, exitCode); + exitCode = JIM_OK; + } + return exitCode; +} + +/* [catch] */ +static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimCatchTryHelper(interp, 0, argc, argv); +} + +/* [try] */ +static int Jim_TryCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimCatchTryHelper(interp, 1, argc, argv); } #if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP) @@ -14043,11 +14860,7 @@ return JIM_ERR; } - if (JimValidName(interp, "new procedure", argv[2])) { - return JIM_ERR; - } - - return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2])); + return Jim_RenameCommand(interp, argv[1], argv[2]); } #define JIM_DICTMATCH_KEYS 0x0001 @@ -14059,30 +14872,32 @@ */ int Jim_DictMatchTypes(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj, int match_type, int return_types) { - Jim_HashEntry *he; Jim_Obj *listObjPtr; - Jim_HashTableIterator htiter; + Jim_Dict *dict; + int i; if (SetDictFromAny(interp, objPtr) != JIM_OK) { return JIM_ERR; } + dict = objPtr->internalRep.dictValue; listObjPtr = Jim_NewListObj(interp, NULL, 0); - JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter); - while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + for (i = 0; i < dict->len; i += 2 ) { + Jim_Obj *keyObj = dict->table[i]; + Jim_Obj *valObj = dict->table[i + 1]; if (patternObj) { - Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj *)he->key : Jim_GetHashEntryVal(he); - if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) { + Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? keyObj : valObj; + if (!Jim_StringMatchObj(interp, patternObj, matchObj, 0)) { /* no match */ continue; } } if (return_types & JIM_DICTMATCH_KEYS) { - Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key); + Jim_ListAppendElement(interp, listObjPtr, keyObj); } if (return_types & JIM_DICTMATCH_VALUES) { - Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he)); + Jim_ListAppendElement(interp, listObjPtr, valObj); } } @@ -14095,7 +14910,7 @@ if (SetDictFromAny(interp, objPtr) != JIM_OK) { return -1; } - return ((Jim_HashTable *)objPtr->internalRep.ptr)->used; + return objPtr->internalRep.dictValue->len / 2; } /** @@ -14112,18 +14927,20 @@ /* Note that we don't optimise the trivial case of a single argument */ for (i = 0; i < objc; i++) { - Jim_HashTable *ht; - Jim_HashTableIterator htiter; - Jim_HashEntry *he; + Jim_Obj **table; + int tablelen; + int j; - if (SetDictFromAny(interp, objv[i]) != JIM_OK) { + /* If the object is a list, avoid converting to a dictionary as + * we may mishandle duplicate keys + */ + table = Jim_DictPairs(interp, objv[i], &tablelen); + if (tablelen && !table) { Jim_FreeNewObj(interp, objPtr); return NULL; } - ht = objv[i]->internalRep.ptr; - JimInitHashTableIterator(ht, &htiter); - while ((he = Jim_NextHashEntry(&htiter)) != NULL) { - Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he)); + for (j = 0; j < tablelen; j += 2) { + DictAddElement(interp, objPtr, table[j], table[j + 1]); } } return objPtr; @@ -14131,50 +14948,19 @@ int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr) { - Jim_HashTable *ht; - unsigned int i; char buffer[100]; - int sum = 0; - int nonzero_count = 0; Jim_Obj *output; - int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; + Jim_Dict *dict; if (SetDictFromAny(interp, objPtr) != JIM_OK) { return JIM_ERR; } - ht = (Jim_HashTable *)objPtr->internalRep.ptr; + dict = objPtr->internalRep.dictValue; /* Note that this uses internal knowledge of the hash table */ - snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size); + snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets", dict->len, dict->size); output = Jim_NewStringObj(interp, buffer, -1); - - for (i = 0; i < ht->size; i++) { - Jim_HashEntry *he = ht->table[i]; - int entries = 0; - while (he) { - entries++; - he = he->next; - } - if (entries > 9) { - bucket_counts[10]++; - } - else { - bucket_counts[entries]++; - } - if (entries) { - sum += entries; - nonzero_count++; - } - } - for (i = 0; i < 10; i++) { - snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]); - Jim_AppendString(interp, output, buffer, -1); - } - snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]); - Jim_AppendString(interp, output, buffer, -1); - snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0); - Jim_AppendString(interp, output, buffer, -1); Jim_SetResult(interp, output); return JIM_OK; } @@ -14207,12 +14993,12 @@ return JIM_ERR; } /* Set the local variables */ - if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) { + dictValues = Jim_DictPairs(interp, objPtr, &len); + if (len && dictValues == NULL) { return JIM_ERR; } for (i = 0; i < len; i += 2) { if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) { - Jim_Free(dictValues); return JIM_ERR; } } @@ -14239,8 +15025,6 @@ } } - Jim_Free(dictValues); - return ret; } @@ -14248,18 +15032,19 @@ static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { Jim_Obj *objPtr; + int rc; int types = JIM_DICTMATCH_KEYS; int option; static const char * const options[] = { "create", "get", "set", "unset", "exists", "keys", "size", "info", "merge", "with", "append", "lappend", "incr", "remove", "values", "for", - "replace", "update", NULL + "replace", "update", "getwithdefault", NULL }; enum { OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO, OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR, - OPT_REPLACE, OPT_UPDATE, + OPT_REPLACE, OPT_UPDATE, OPT_GETDEF, }; if (argc < 2) { @@ -14268,7 +15053,11 @@ } if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) { - return Jim_CheckShowCommands(interp, argv[1], options); + /* Handle getdef as an alias for getwithdefault */ + if (Jim_CompareStringImmediate(interp, argv[1], "getdef") == 0) { + return Jim_CheckShowCommands(interp, argv[1], options); + } + option = OPT_GETDEF; } switch (option) { @@ -14284,6 +15073,24 @@ Jim_SetResult(interp, objPtr); return JIM_OK; + case OPT_GETDEF: + if (argc < 5) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...? key default"); + return JIM_ERR; + } + rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 4, &objPtr, JIM_ERRMSG); + if (rc == -1) { + /* Not a valid dictionary */ + return JIM_ERR; + } + if (rc == JIM_ERR) { + Jim_SetResult(interp, argv[argc - 1]); + } + else { + Jim_SetResult(interp, objPtr); + } + return JIM_OK; + case OPT_SET: if (argc < 5) { Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value"); @@ -14297,7 +15104,7 @@ return JIM_ERR; } else { - int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG); + int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_NONE); if (rc < 0) { return JIM_ERR; } @@ -14310,7 +15117,7 @@ Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?"); return JIM_ERR; } - if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) { + if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, JIM_NONE) != JIM_OK) { return JIM_ERR; } return JIM_OK; @@ -14423,6 +15230,15 @@ return JIM_OK; } +#ifdef jim_ext_namespace +static int JimIsGlobalNamespace(Jim_Obj *objPtr) +{ + int len; + const char *str = Jim_GetString(objPtr, &len); + return len >= 2 && str[0] == ':' && str[1] == ':'; +} +#endif + /* [info] */ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { @@ -14508,7 +15324,7 @@ } #ifdef jim_ext_namespace if (!nons) { - if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) { + if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) { return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1); } } @@ -14530,7 +15346,7 @@ } #ifdef jim_ext_namespace if (!nons) { - if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) { + if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) { return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1); } } @@ -15012,22 +15828,23 @@ static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { Jim_Obj *objPtr; - long count; + jim_wide count; - if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) { + if (argc < 2 || Jim_GetWideExpr(interp, argv[1], &count) != JIM_OK || count < 0) { Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?"); return JIM_ERR; } - if (count == 0 || argc == 2) { + Jim_SetEmptyResult(interp); return JIM_OK; } argc -= 2; argv += 2; - objPtr = Jim_NewListObj(interp, argv, argc); - while (--count) { + objPtr = Jim_NewListObj(interp, NULL, 0); + ListEnsureLength(objPtr, argc * count); + while (count--) { ListInsertElements(objPtr, -1, argc, argv); } @@ -15087,7 +15904,7 @@ return JIM_OK; } - if (argc < 2) { + if (argc > 3) { Jim_WrongNumArgs(interp, 1, argv, "varName ?default?"); return JIM_ERR; } @@ -15130,8 +15947,9 @@ return JIM_ERR; } JimListGetElements(interp, argv[1], &len, &ele); - len--; revObjPtr = Jim_NewListObj(interp, NULL, 0); + ListEnsureLength(revObjPtr, len); + len--; while (len >= 0) ListAppendElement(revObjPtr, ele[len--]); Jim_SetResult(interp, revObjPtr); @@ -15176,14 +15994,14 @@ return JIM_ERR; } if (argc == 2) { - if (Jim_GetWide(interp, argv[1], &end) != JIM_OK) + if (Jim_GetWideExpr(interp, argv[1], &end) != JIM_OK) return JIM_ERR; } else { - if (Jim_GetWide(interp, argv[1], &start) != JIM_OK || - Jim_GetWide(interp, argv[2], &end) != JIM_OK) + if (Jim_GetWideExpr(interp, argv[1], &start) != JIM_OK || + Jim_GetWideExpr(interp, argv[2], &end) != JIM_OK) return JIM_ERR; - if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK) + if (argc == 4 && Jim_GetWideExpr(interp, argv[3], &step) != JIM_OK) return JIM_ERR; } if ((len = JimRangeLen(start, end, step)) == -1) { @@ -15191,6 +16009,7 @@ return JIM_ERR; } objPtr = Jim_NewListObj(interp, NULL, 0); + ListEnsureLength(objPtr, len); for (i = 0; i < len; i++) ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step)); Jim_SetResult(interp, objPtr); @@ -15209,11 +16028,11 @@ if (argc == 1) { max = JIM_WIDE_MAX; } else if (argc == 2) { - if (Jim_GetWide(interp, argv[1], &max) != JIM_OK) + if (Jim_GetWideExpr(interp, argv[1], &max) != JIM_OK) return JIM_ERR; } else if (argc == 3) { - if (Jim_GetWide(interp, argv[1], &min) != JIM_OK || - Jim_GetWide(interp, argv[2], &max) != JIM_OK) + if (Jim_GetWideExpr(interp, argv[1], &min) != JIM_OK || + Jim_GetWideExpr(interp, argv[2], &max) != JIM_OK) return JIM_ERR; } len = max-min; @@ -15264,13 +16083,16 @@ {"lreplace", Jim_LreplaceCoreCommand}, {"lsort", Jim_LsortCoreCommand}, {"append", Jim_AppendCoreCommand}, +#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP) {"debug", Jim_DebugCoreCommand}, +#endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */ {"eval", Jim_EvalCoreCommand}, {"uplevel", Jim_UplevelCoreCommand}, {"expr", Jim_ExprCoreCommand}, {"break", Jim_BreakCoreCommand}, {"continue", Jim_ContinueCoreCommand}, {"proc", Jim_ProcCoreCommand}, + {"xtrace", Jim_XtraceCoreCommand}, {"concat", Jim_ConcatCoreCommand}, {"return", Jim_ReturnCoreCommand}, {"upvar", Jim_UpvarCoreCommand}, @@ -15279,6 +16101,7 @@ {"time", Jim_TimeCoreCommand}, {"exit", Jim_ExitCoreCommand}, {"catch", Jim_CatchCoreCommand}, + {"try", Jim_TryCoreCommand}, #ifdef JIM_REFERENCES {"ref", Jim_RefCoreCommand}, {"getref", Jim_GetrefCoreCommand}, @@ -15571,6 +16394,19 @@ } } +/* Should be called as the first thing in a loadable module to verify + * that the interpeter ABI is compatible with the ABI that the module was compiled against. + * Returns JIM_ERR and sets an error if mismatch. + */ +int Jim_CheckAbiVersion(Jim_Interp *interp, int abi_version) +{ + if (abi_version != JIM_ABI_VERSION) { + Jim_SetResultString(interp, "ABI version mismatch", -1); + return JIM_ERR; + } + return JIM_OK; +} + /* stubs */ #ifndef jim_ext_package int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags) diff -Nru jimtcl-0.79+dfsg0/jim-clock.c jimtcl-0.81+dfsg0/jim-clock.c --- jimtcl-0.79+dfsg0/jim-clock.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-clock.c 2021-11-27 23:06:54.000000000 +0000 @@ -228,9 +228,7 @@ int Jim_clockInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "clock", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "clock"); Jim_CreateCommand(interp, "clock", Jim_SubCmdProc, (void *)clock_command_table, NULL); return JIM_OK; } diff -Nru jimtcl-0.79+dfsg0/jimdb jimtcl-0.81+dfsg0/jimdb --- jimtcl-0.79+dfsg0/jimdb 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/jimdb 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,466 @@ +#!/usr/bin/env jimsh +# vim:se syntax=tcl: +# +# A simple command line debugger for Jim Tcl. + +set opt_trace 0 + +set argv [lassign $argv argv0] +if {[string match -t* $argv0]} { + set opt_trace 1 + set argv [lassign $argv argv0] +} + +if {$argv0 eq ""} { + stderr puts "Usage: jimdb ?-trace? script ?args ...?" + exit 1 +} + +puts "Jim Tcl debugger v1.0 - Use ? for help\n" + +# --- debugger implementation --- +proc debugger::w {&s} { + set n 0 + foreach t $s(stacktrace) { + lassign $t f l p args + set args [debugger::_squash $args] + if {$f eq ""} { + set loc "" + } else { + set loc " @ $f:$l" + } + puts [format "%s #%s %s" $($n == $s(level) ? ">" : " ") $n "$p $args $loc"] + incr n + } +} + +proc debugger::? {&s {cmd ""}} { + set help { + s {s "step into" "Step to the next command"} + w {w "where (stacktrace)" "Displays the current stack trace. The current frame is identified with >"} + n {n "step over" "Step to the next command without entering procs"} + l {"l [loc]" "list source" "Lists source code. loc may be filename, filename:line, line, procname"} + r {r "step out" "Continue until the current proc exits"} + v {v "local vars" "Display all local variables in the current frame"} + c {c "continue" "Continue until a breakpoint or ^C"} + u {u "up stack frame" "Move up stack frame (towards #0)"} + p {"p [expr]" "print" "Prints an expression (or variable). e.g. p x, p \$x / 3"} + d {d "down stack frame" "Move down stack frame (away from #0)"} + b {"b [loc]" "breakpoints" "List breakpoints (no args), or set a breakpoint at filename:line, line or procname"} + t {"t [0|1|2]" "trace" "Toggle command tracing on/off, or sets given trace mode"} + ? {"? [cmd]" "help" "Display general help or for the given command"} + q {q "quit" "Quit the script"} + } + if {$cmd eq ""} { + foreach {cmd1 info1 cmd2 info2} $help { + lassign $info1 u1 desc1 + lassign $info2 u2 desc2 + puts [format " %-9s %-20s %-9s %-20s" $u1 $desc1 $u2 $desc2] + } + } elseif {[exists help($cmd)]} { + lassign $help($cmd) u desc detail + puts "$u $detail" + } else { + puts "No such command: $cmd" + } +} + +proc debugger::c {&s} { + return -code break +} + +proc debugger::p {&s expr} { + if {[catch {uplevel #$s(level) [list expr $expr]} msg]} { + if {[uplevel #$s(level) exists $expr]} { + puts "p \$$expr" + catch {uplevel #$s(level) [list set $expr]} msg + } + } + return $msg +} + +proc debugger::q {&s} { + exit 0 +} + +proc debugger::b {&s {loc ""}} { + if {$loc eq ""} { + foreach bp [lsort [dict keys $s(bplines)]] { + puts "Breakpoint at [dict get $s bplines $bp] ($bp)" + } + foreach bp [lsort [dict keys $s(bpprocs)]] { + puts "Breakpoint at $bp" + } + return + } + lassign [debugger::_findloc s $loc 0] file line + if {$file ne ""} { + dict set s(bplines) $file:$line $loc + puts "Breakpoint at $file:$line" + } else { + set procs [lsort [info procs $loc]] + if {[llength $procs] > 5} { + puts "Too many matches: $procs" + } elseif {[llength $procs] == 0} { + dict set s(bpprocs) $loc 1 + puts "Breakpoint at $loc (future)" + } else { + foreach p $procs { + lassign [debugger::_findloc s $p] file line + dict set s(bpprocs) $p $file:$line + puts "Breakpoint at $p ($file:$line)" + } + } + } + return +} + +proc debugger::n {&s} { + set s(bplevel) $s(blevel) + return -code break +} + +proc debugger::r {&s} { + incr s(bplevel) -1 + return -code break +} + +proc debugger::s {&s} { + set s(bpany) 1 + return -code break +} + +proc debugger::v {&s {pat *}} { + set level #$s(level) + if {$s(level) == 0} { + set vars [info globals $pat] + } else { + set vars [uplevel $level info locals $pat] + } + foreach i [lsort $vars] { + puts "$i = [debugger::_squash [uplevel $level set $i]]" + } +} + +proc debugger::u {&s} { + if {$s(level) > 0} { + incr s(level) -1 + } + tailcall debugger::w s +} + +proc debugger::d {&s} { + if {$s(level) < [info level] - 2} { + incr s(level) + } + tailcall debugger::w s +} + +proc debugger::t {&s {mode {}}} { + if {$mode eq ""} { + set mode $(!$s(trace)) + } + switch -exact -- $mode { + 0 { + set msg off + } + 1 { + set msg on + } + 2 { + set msg full + } + default { + error "Unknown trace mode: $mode" + } + } + set s(trace) $mode + puts "Tracing is now $msg" +} + +proc debugger::l {&s {loc {}}} { + if {$loc eq ""} { + lassign $s(active) file line + if {$file eq ""} { + return "No source location available" + } + } else { + lassign [debugger::_findloc s $loc] file line + } + if {$file eq ""} { + return "Don't know anything about: $loc" + } + puts "@ $file" + debugger::_showlines s $file $line 8 + set s(lastcmd) "l $file:$($line + 8)" + return +} + +# ----- internal commands below this point ----- + +# This proc can be overridden to read commands from +# some other location, such as remote socket +proc debugger::_getcmd {&s &cmd} { + if {![exists s(historyfile)]} { + set s(historyfile) [env HOME]/.jimdb_history + history load $s(historyfile) + } + while 1 { + if {[history getline "dbg> " cmd] < 0} { + signal default SIGINT + puts "Use q to quit, ? for help" + set cmd "" + return 0 + } + if {$cmd eq "h"} { + history show + continue + } + # Don't bother adding single char commands to the history + if {[string length $cmd] > 1} { + history add $cmd + history save $s(historyfile) + } + return 1 + } +} + +proc debugger::?? {&s} { + parray s + return "" +} + +proc debugger::_squash {arglist} { + set arglist [regsub -all "\[\n\t\r \]+" $arglist { }] + if {[string length $arglist] > 60} { + set arglist [string range $arglist 0 57]... + } + return $arglist +} + +# Converts something which looks like a location into a file/line +# number -> file=active, line=number +# filename -> file=filename, line=1 +# filename:number -> file=filename, line=number +# procname -> file, line = of first line of body +proc debugger::_findloc {&s loc {checkproc 1}} { + lassign $s(active) afile aline + if {[string is integer -strict $loc]} { + set result [list $afile $loc] + } else { + if {[string match *:* $loc]} { + regexp (.*):(.*) $loc -> file line + } else { + set file $loc + set line 1 + } + if {[file exists $file]} { + set result [list $file $line] + } elseif {$checkproc && [exists -proc $loc]} { + set result [info source [info body $loc]] + } else { + set result "" + } + } + return $result +} + +proc debugger::_showlines {&s file line context} { + lassign $s(active) afile aline + if {[catch { + set file [debugger::_findfile $file] + set f [open $file] + set file [file tail $file] + set afile [file tail $afile] + set n 0 + set lines [split [$f read] \n] + if {$line >= [llength $lines]} { + set line [llength $lines] + } + foreach l $lines { + incr n + if {$n > $line + $context} { + break + } + if {$n >= $line - $context} { + if {$n == $aline && $file eq $afile} { + set marker ">" + } elseif {$n == $line} { + set marker "*" + } else { + set marker " " + } + puts [format "%s%4d %s" $marker $n $l] + } + } + $f close + } msg]} { + puts $msg + } +} + +proc debugger::_showloc {&s file line name arglist} { + set tail [file tail $file] + if {$file eq ""} { + puts "@ $name [debugger::_squash $arglist]" + } else { + puts "@ $tail:$line $name [debugger::_squash $arglist]" + debugger::_showlines s $file $line 1 + } +} + +proc debugger::_checkbp {&s file line name} { + if {[signal check -clear SIGINT] ne ""} { + return 1 + } + if {$s(bpany) == 0} { + return 1 + } + # We don't want to stop on the same line with a different command + # when stepping with 'n'. This isn't perfect since the same + # command might be part of a nested expression, but we have no additional + # information available. + if {$s(laststop) eq "$file:$line" && $s(prevname) ne $name} { + return 0 + } + if {$s(blevel) <= $s(bplevel)} { + return 1 + } + if {[dict exists $s(bplines) $file:$line]} { + puts "Breakpoint @ $file:$line" + return 1 + } + return 0 +} + +proc debugger::_findfile {filename} { + # Search for the given file in likely places + foreach dir [list {*}$::auto_path . [file dirname $::argv0] [file dirname [info nameofexecutable]]] { + if {[file exists $dir/$filename]} { + return $dir/$filename + } + } + return $filename +} + +# The execution trace (xtrace) callback +proc debugger::_db {type file line result name arglist} { + upvar #0 debugger::state s + + #puts "@ $file:$line ($result) $type $name [debugger::_squash $arglist]" + + # proc is only used to activate breakpoints + if {$type eq "proc"} { + # If we aren't already going to stop at the next command + # do so if we have a proc breakpoint + if {$s(bpany) != 1} { + set s(bpany) [dict exists $s bpprocs $name] + } + return + } + + # level is the proc frame level + set s(level) $([info level] - 1) + # blevel is the breakpoint level for n, r commands + set s(blevel) [info level] + set s(active) [list $file $line $name $arglist] + + incr s(bpany) -1 + + if {[catch -nobreak -noreturn { + if {[debugger::_checkbp s $file $line $name]} { + # Breakpoint here + set s(bpany) 0 + set s(bplevel) -1 + set s(laststop) $file:$line + set s(prevname) $name + + # Build the active stacktrace + set s(stacktrace) {} + foreach level [range 1 [info level]] { + lassign [info frame $level] p f l + lassign [info level $level] p pargs + lappend s(stacktrace) [list $f $l $p $pargs] + } + lappend s(stacktrace) $s(active) + + if {$result ne ""} { + puts "=> [debugger::_squash $result]" + } + debugger::_showloc s $file $line $name $arglist + + set buf {} + while {1} { + set rc [debugger::_getcmd s buf] + if {$rc == -1} { + # Stop tracing + return + } + if {$buf eq ""} { + set buf $s(lastcmd) + } else { + set s(lastcmd) $buf + } + + # Mark the active stack frame + set s(active) [lindex $s(stacktrace) $s(level)] + + set args [lassign $buf cmd] + catch -nobreak { + if {[exists -proc debugger::$cmd]} { + debugger::$cmd s {*}$args + } else { + uplevel #$s(level) $buf + } + } result + if {$result ne ""} { + puts $result + } + } + } elseif {$s(trace) && $file ne ""} { + if {$s(trace) == 2 && $result ne ""} { + puts "=> [debugger::_squash $result]" + } + if {$file ne $s(lastsource)} { + puts "@ $file" + } + set s(lastsource) $file + debugger::_showlines s $file $line 0 + } + } err opts]} { + puts [errorInfo $err] + exit 1 + } +} + +# Allows a breakpoint to be manually inserted +# The message is for documentation purposes +proc breakpoint {{msg ""}} { + set ::debugger::state(bpany) 1 +} + +signal ignore SIGINT + +set debugger::state { + bplevel -1 + bpany -1 + bplines {} + bpprocs {} + lastcmd "" + laststop "" + level 0 + trace 0 + active {} + prevname {} + stacktrace {} + lastsource {} +} + +set debugger::state(trace) $opt_trace +# Break at the very next command after source +set debugger::state(bpany) 2 + +# Install the debugger +xtrace debugger::_db + +source $argv0 diff -Nru jimtcl-0.79+dfsg0/jim-eventloop.c jimtcl-0.81+dfsg0/jim-eventloop.c --- jimtcl-0.79+dfsg0/jim-eventloop.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-eventloop.c 2021-11-27 23:06:54.000000000 +0000 @@ -148,6 +148,16 @@ } +/** + * Register a file event handler on the given file descriptor with the given mask + * (may be 1 or more of JIM_EVENT_xxx) + * + * When the event occurs, proc is called with clientData and the mask of events that occurred. + * When the filehandler is removed, finalizerProc is called. + * + * Note that no check is made that only one handler is registered for the given + * event(s). + */ void Jim_CreateFileHandler(Jim_Interp *interp, int fd, int mask, Jim_FileProc * proc, void *clientData, Jim_EventFinalizerProc * finalizerProc) { @@ -164,6 +174,45 @@ eventLoop->fileEventHead = fe; } +static int JimEventHandlerScript(Jim_Interp *interp, void *clientData, int mask) +{ + return Jim_EvalObjBackground(interp, (Jim_Obj *)clientData); +} + +static void JimEventHandlerScriptFinalize(Jim_Interp *interp, void *clientData) +{ + Jim_DecrRefCount(interp, (Jim_Obj *)clientData); +} + +/** + * A convenience version of Jim_CreateFileHandler() which evaluates + * scriptObj with Jim_EvalObjBackground() when the event occurs. + */ +void Jim_CreateScriptFileHandler(Jim_Interp *interp, int fd, int mask, + Jim_Obj *scriptObj) +{ + Jim_IncrRefCount(scriptObj); + Jim_CreateFileHandler(interp, fd, mask, JimEventHandlerScript, scriptObj, JimEventHandlerScriptFinalize); +} + +/** + * If there is a file handler registered with the given mask, return the clientData + * for the (first) handler. + * Otherwise return NULL. + */ +void *Jim_FindFileHandler(Jim_Interp *interp, int fd, int mask) +{ + Jim_FileEvent *fe; + Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop"); + + for (fe = eventLoop->fileEventHead; fe; fe = fe->next) { + if (fe->fd == fd && (fe->mask & mask)) { + return fe->clientData; + } + } + return NULL; +} + /** * Removes all event handlers for 'handle' that match 'mask'. */ @@ -745,8 +794,7 @@ { Jim_EventLoop *eventLoop; - if (Jim_PackageProvide(interp, "eventloop", "1.0", JIM_ERRMSG)) - return JIM_ERR; + Jim_PackageProvideCheck(interp, "eventloop"); eventLoop = Jim_Alloc(sizeof(*eventLoop)); memset(eventLoop, 0, sizeof(*eventLoop)); diff -Nru jimtcl-0.79+dfsg0/jim-eventloop.h jimtcl-0.81+dfsg0/jim-eventloop.h --- jimtcl-0.79+dfsg0/jim-eventloop.h 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-eventloop.h 2021-11-27 23:06:54.000000000 +0000 @@ -64,6 +64,8 @@ int fd, int mask, Jim_FileProc *proc, void *clientData, Jim_EventFinalizerProc *finalizerProc); +JIM_EXPORT void Jim_CreateScriptFileHandler(Jim_Interp *interp, + int fd, int mask, Jim_Obj *scriptObj); JIM_EXPORT void Jim_DeleteFileHandler (Jim_Interp *interp, int fd, int mask); JIM_EXPORT jim_wide Jim_CreateTimeHandler (Jim_Interp *interp, @@ -71,6 +73,7 @@ Jim_TimeProc *proc, void *clientData, Jim_EventFinalizerProc *finalizerProc); JIM_EXPORT jim_wide Jim_DeleteTimeHandler (Jim_Interp *interp, jim_wide id); +JIM_EXPORT void *Jim_FindFileHandler(Jim_Interp *interp, int fd, int mask); #define JIM_FILE_EVENTS 1 #define JIM_TIME_EVENTS 2 diff -Nru jimtcl-0.79+dfsg0/jim-exec.c jimtcl-0.81+dfsg0/jim-exec.c --- jimtcl-0.79+dfsg0/jim-exec.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-exec.c 2021-11-27 23:06:54.000000000 +0000 @@ -82,9 +82,7 @@ int Jim_execInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "exec", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "exec"); Jim_CreateCommand(interp, "exec", Jim_ExecCmd, NULL, NULL); return JIM_OK; } @@ -986,9 +984,6 @@ */ pidPtr = Jim_Alloc(cmdCount * sizeof(*pidPtr)); - for (i = 0; i < numPids; i++) { - pidPtr[i] = JIM_BAD_PID; - } for (firstArg = 0; firstArg < arg_count; numPids++, firstArg = lastArg + 1) { int pipe_dup_err = 0; int origErrorId = errorId; @@ -1051,25 +1046,25 @@ if (pid == 0) { /* Child */ /* Set up stdin, stdout, stderr */ - if (inputId != -1) { + if (inputId != -1 && inputId != fileno(stdin)) { dup2(inputId, fileno(stdin)); close(inputId); } - if (outputId != -1) { + if (outputId != -1 && outputId != fileno(stdout)) { dup2(outputId, fileno(stdout)); if (outputId != errorId) { close(outputId); } } - if (errorId != -1) { + if (errorId != -1 && errorId != fileno(stderr)) { dup2(errorId, fileno(stderr)); close(errorId); } /* Close parent-only file descriptors */ - if (outPipePtr) { + if (outPipePtr && *outPipePtr != -1) { close(*outPipePtr); } - if (errFilePtr) { + if (errFilePtr && *errFilePtr != -1) { close(*errFilePtr); } if (pipeIds[0] != -1) { @@ -1233,8 +1228,8 @@ int Jim_execInit(Jim_Interp *interp) { struct WaitInfoTable *waitinfo; - if (Jim_PackageProvide(interp, "exec", "1.0", JIM_ERRMSG)) - return JIM_ERR; + + Jim_PackageProvideCheck(interp, "exec"); waitinfo = JimAllocWaitInfoTable(); Jim_CreateCommand(interp, "exec", Jim_ExecCmd, waitinfo, JimFreeWaitInfoTable); diff -Nru jimtcl-0.79+dfsg0/jim-file.c jimtcl-0.81+dfsg0/jim-file.c --- jimtcl-0.79+dfsg0/jim-file.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-file.c 2021-11-27 23:06:54.000000000 +0000 @@ -48,10 +48,10 @@ #include #include #include -#include #include #include +#include #ifdef HAVE_UTIMES #include @@ -161,7 +161,7 @@ Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, value)); } -static int StoreStatData(Jim_Interp *interp, Jim_Obj *varName, const struct stat *sb) +static int StoreStatData(Jim_Interp *interp, Jim_Obj *varName, const jim_stat_t *sb) { /* Just use a list to store the data */ Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); @@ -254,11 +254,13 @@ const char *path = Jim_String(objPtr); const char *p = strrchr(path, '/'); - if (!p && path[0] == '.' && path[1] == '.' && path[2] == '\0') { - Jim_SetResultString(interp, "..", -1); - } else if (!p) { + if (!p) { Jim_SetResultString(interp, ".", -1); } + else if (p[1] == 0) { + /* Trailing slash so do nothing */ + Jim_SetResult(interp, objPtr); + } else if (p == path) { Jim_SetResultString(interp, "/", -1); } @@ -306,18 +308,16 @@ static int file_cmd_rootname(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - Jim_Obj *objPtr = JimStripTrailingSlashes(interp, argv[0]); - const char *path = Jim_String(objPtr); + const char *path = Jim_String(argv[0]); const char *lastSlash = strrchr(path, '/'); const char *p = strrchr(path, '.'); if (p == NULL || (lastSlash != NULL && lastSlash > p)) { - Jim_SetResult(interp, objPtr); + Jim_SetResult(interp, argv[0]); } else { Jim_SetResultString(interp, path, p - path); } - Jim_DecrRefCount(interp, objPtr); return JIM_OK; } @@ -541,9 +541,9 @@ } /* Maybe it already exists as a directory */ if (errno == EEXIST) { - struct stat sb; + jim_stat_t sb; - if (stat(path, &sb) == 0 && S_ISDIR(sb.st_mode)) { + if (Jim_Stat(path, &sb) == 0 && S_ISDIR(sb.st_mode)) { return 0; } /* Restore errno */ @@ -607,7 +607,12 @@ argv[1]); return JIM_ERR; } - +#if ISWINDOWS + if (access(dest, F_OK) == 0) { + /* Windows won't rename over an existing file */ + remove(dest); + } +#endif if (rename(source, dest) != 0) { Jim_SetResultFormatted(interp, "error renaming \"%#s\" to \"%#s\": %s", argv[0], argv[1], strerror(errno)); @@ -655,11 +660,11 @@ } #endif -static int file_stat(Jim_Interp *interp, Jim_Obj *filename, struct stat *sb) +static int file_stat(Jim_Interp *interp, Jim_Obj *filename, jim_stat_t *sb) { const char *path = Jim_String(filename); - if (stat(path, sb) == -1) { + if (Jim_Stat(path, sb) == -1) { Jim_SetResultFormatted(interp, "could not read \"%#s\": %s", filename, strerror(errno)); return JIM_ERR; } @@ -667,7 +672,7 @@ } #ifdef HAVE_LSTAT -static int file_lstat(Jim_Interp *interp, Jim_Obj *filename, struct stat *sb) +static int file_lstat(Jim_Interp *interp, Jim_Obj *filename, jim_stat_t *sb) { const char *path = Jim_String(filename); @@ -683,7 +688,7 @@ static int file_cmd_atime(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; if (file_stat(interp, argv[0], &sb) != JIM_OK) { return JIM_ERR; @@ -716,7 +721,7 @@ static int file_cmd_mtime(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; if (argc == 2) { jim_wide secs; @@ -735,7 +740,7 @@ #ifdef STAT_MTIME_US static int file_cmd_mtimeus(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; if (argc == 2) { jim_wide us; @@ -759,7 +764,7 @@ static int file_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; if (file_stat(interp, argv[0], &sb) != JIM_OK) { return JIM_ERR; @@ -770,7 +775,7 @@ static int file_cmd_isdirectory(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; int ret = 0; if (file_stat(interp, argv[0], &sb) == JIM_OK) { @@ -782,7 +787,7 @@ static int file_cmd_isfile(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; int ret = 0; if (file_stat(interp, argv[0], &sb) == JIM_OK) { @@ -795,7 +800,7 @@ #ifdef HAVE_GETEUID static int file_cmd_owned(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; int ret = 0; if (file_stat(interp, argv[0], &sb) == JIM_OK) { @@ -816,7 +821,7 @@ if (linkLength == -1) { Jim_Free(linkValue); - Jim_SetResultFormatted(interp, "couldn't readlink \"%#s\": %s", argv[0], strerror(errno)); + Jim_SetResultFormatted(interp, "could not read link \"%#s\": %s", argv[0], strerror(errno)); return JIM_ERR; } linkValue[linkLength] = 0; @@ -827,7 +832,7 @@ static int file_cmd_type(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; if (file_lstat(interp, argv[0], &sb) != JIM_OK) { return JIM_ERR; @@ -839,7 +844,7 @@ #ifdef HAVE_LSTAT static int file_cmd_lstat(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; if (file_lstat(interp, argv[0], &sb) != JIM_OK) { return JIM_ERR; @@ -852,7 +857,7 @@ static int file_cmd_stat(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - struct stat sb; + jim_stat_t sb; if (file_stat(interp, argv[0], &sb) != JIM_OK) { return JIM_ERR; @@ -1114,9 +1119,7 @@ int Jim_fileInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "file", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "file"); Jim_CreateCommand(interp, "file", Jim_SubCmdProc, (void *)file_command_table, NULL); Jim_CreateCommand(interp, "pwd", Jim_PwdCmd, NULL, NULL); Jim_CreateCommand(interp, "cd", Jim_CdCmd, NULL, NULL); diff -Nru jimtcl-0.79+dfsg0/jim-format.c jimtcl-0.81+dfsg0/jim-format.c --- jimtcl-0.79+dfsg0/jim-format.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-format.c 2021-11-27 23:06:54.000000000 +0000 @@ -331,7 +331,7 @@ j = 0; for (i = length; i > 0; ) { i--; - if (w & ((unsigned jim_wide)1 << i)) { + if (w & ((unsigned jim_wide)1 << i)) { num_buffer[j++] = '1'; } else if (j || i == 0) { diff -Nru jimtcl-0.79+dfsg0/jim.h jimtcl-0.81+dfsg0/jim.h --- jimtcl-0.79+dfsg0/jim.h 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim.h 2021-11-27 23:06:54.000000000 +0000 @@ -125,6 +125,9 @@ * Exported defines * ---------------------------------------------------------------------------*/ +/* Increment this every time the public ABI changes */ +#define JIM_ABI_VERSION 100 + #define JIM_OK 0 #define JIM_ERR 1 #define JIM_RETURN 2 @@ -133,7 +136,7 @@ #define JIM_SIGNAL 5 #define JIM_EXIT 6 /* The following are internal codes and should never been seen/used */ -#define JIM_EVAL 7 +#define JIM_EVAL 7 /* tailcall */ #define JIM_MAX_CALLFRAME_DEPTH 1000 /* default max nesting depth for procs */ #define JIM_MAX_EVAL_DEPTH 2000 /* default max nesting depth for eval */ @@ -161,6 +164,7 @@ /* Flags used by API calls getting a 'nocase' argument. */ #define JIM_CASESENS 0 /* case sensitive */ #define JIM_NOCASE 1 /* no case */ +#define JIM_OPT_END 2 /* if implemented by a command (e.g. regexp), add -- to the argument list */ /* Filesystem related */ #define JIM_PATH_LEN 1024 @@ -235,6 +239,8 @@ (entry)->u.val = (_val_); \ } while(0) +#define Jim_SetHashIntVal(ht, entry, _val_) (entry)->u.intval = (_val_) + #define Jim_FreeEntryKey(ht, entry) \ if ((ht)->type->keyDestructor) \ (ht)->type->keyDestructor((ht)->privdata, (entry)->key) @@ -255,6 +261,7 @@ #define Jim_GetHashEntryKey(he) ((he)->key) #define Jim_GetHashEntryVal(he) ((he)->u.val) +#define Jim_GetHashEntryIntVal(he) ((he)->u.intval) #define Jim_GetHashTableCollisions(ht) ((ht)->collisions) #define Jim_GetHashTableSize(ht) ((ht)->size) #define Jim_GetHashTableUsed(ht) ((ht)->used) @@ -317,6 +324,8 @@ int len; /* Length */ int maxLen; /* Allocated 'ele' length */ } listValue; + /* dict object */ + struct Jim_Dict *dictValue; /* String type */ struct { int maxLength; @@ -454,7 +463,22 @@ Jim_Obj *const *argv); typedef void Jim_DelCmdProc(struct Jim_Interp *interp, void *privData); - +/* The dict structure. It uses the same approach as Python OrderedDict + * of storing a hash table of table offsets into a table containing keys and objects. + * This preserves order when adding and replacing elements. + */ +typedef struct Jim_Dict { + struct JimDictHashEntry { + int offset; + unsigned hash; + } *ht; /* Allocated hash table of size 'size' */ + unsigned int size; /* Size of the hash table (0 or power of two) */ + unsigned int sizemask; /* mask to apply to hash to index into offsets table */ + unsigned int uniq; /* unique value to add to hash generator */ + Jim_Obj **table; /* Table of alternating key, value elements */ + int len; /* Number of used elements in table */ + int maxLen; /* Allocated length of table */ +} Jim_Dict; /* A command is implemented in C if isproc is 0, otherwise * it is a Tcl procedure with the arglist and body represented by the @@ -525,6 +549,8 @@ 'ID' field contained in the Jim_CallFrame structure. */ int local; /* If 'local' is in effect, newly defined procs keep a reference to the old defn */ + int quitting; /* Set to 1 during Jim_FreeInterp() */ + int safeexpr; /* Set when evaluating a "safe" expression, no var subst or command eval */ Jim_Obj *liveList; /* Linked list of all the live objects. */ Jim_Obj *freeList; /* Linked list of all the unused objects. */ Jim_Obj *currentScriptObj; /* Script currently in execution. */ @@ -539,16 +565,20 @@ is running as sentinel to avoid to recursive calls via the [collect] command inside finalizers. */ - time_t lastCollectTime; /* unix time of the last GC execution */ + jim_wide lastCollectTime; /* unix time of the last GC execution */ Jim_Obj *stackTrace; /* Stack trace object. */ Jim_Obj *errorProc; /* Name of last procedure which returned an error */ Jim_Obj *unknown; /* Unknown command cache */ + Jim_Obj *defer; /* "jim::defer" */ + Jim_Obj *traceCmdObj; /* If non-null, execution trace command to invoke */ int unknown_called; /* The unknown command has been invoked */ int errorFlag; /* Set if an error occurred during execution. */ void *cmdPrivData; /* Used to pass the private data pointer to a command. It is set to what the user specified via Jim_CreateCommand(). */ + Jim_Cmd *oldCmdCache; /* commands that have been deleted, but may still be cached */ + int oldCmdCacheSize; /* Number of delete commands */ struct Jim_CallFrame *freeFramesList; /* list of CallFrame structures. */ struct Jim_HashTable assocData; /* per-interp storage for use by packages */ Jim_PrngState *prngState; /* per interpreter Random Number Gen. state. */ @@ -560,7 +590,6 @@ * At some point may be a real function doing more work. * The proc epoch is used in order to know when a command lookup * cached can no longer considered valid. */ -#define Jim_InterpIncrProcEpoch(i) (i)->procEpoch++ #define Jim_SetResultString(i,s,l) Jim_SetResult(i, Jim_NewStringObj(i,s,l)) #define Jim_SetResultInt(i,intval) Jim_SetResult(i, Jim_NewIntObj(i,intval)) /* Note: Using trueObj and falseObj here makes some things slower...*/ @@ -699,8 +728,6 @@ Jim_Obj *objPtr, const char *str); JIM_EXPORT int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase); -JIM_EXPORT int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, - Jim_Obj *secondObjPtr, int nocase); JIM_EXPORT int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr); /* reference object */ @@ -724,9 +751,9 @@ const char *cmdName, Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc); JIM_EXPORT int Jim_DeleteCommand (Jim_Interp *interp, - const char *cmdName); + Jim_Obj *cmdNameObj); JIM_EXPORT int Jim_RenameCommand (Jim_Interp *interp, - const char *oldName, const char *newName); + Jim_Obj *oldNameObj, Jim_Obj *newNameObj); JIM_EXPORT Jim_Cmd * Jim_GetCommand (Jim_Interp *interp, Jim_Obj *objPtr, int flags); JIM_EXPORT int Jim_SetVariable (Jim_Interp *interp, @@ -797,8 +824,8 @@ JIM_EXPORT int Jim_SetDictKeysVector (Jim_Interp *interp, Jim_Obj *varNamePtr, Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags); -JIM_EXPORT int Jim_DictPairs(Jim_Interp *interp, - Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len); +JIM_EXPORT Jim_Obj **Jim_DictPairs(Jim_Interp *interp, + Jim_Obj *dictPtr, int *len); JIM_EXPORT int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr); @@ -827,6 +854,8 @@ /* integer object */ JIM_EXPORT int Jim_GetWide (Jim_Interp *interp, Jim_Obj *objPtr, jim_wide *widePtr); +JIM_EXPORT int Jim_GetWideExpr(Jim_Interp *interp, Jim_Obj *objPtr, + jim_wide *widePtr); JIM_EXPORT int Jim_GetLong (Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr); #define Jim_NewWideObj Jim_NewIntObj @@ -865,13 +894,18 @@ JIM_EXPORT int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc *delProc, void *data); JIM_EXPORT int Jim_DeleteAssocData(Jim_Interp *interp, const char *key); +JIM_EXPORT int Jim_CheckAbiVersion(Jim_Interp *interp, int abi_version); /* Packages C API */ + /* jim-package.c */ JIM_EXPORT int Jim_PackageProvide (Jim_Interp *interp, const char *name, const char *ver, int flags); JIM_EXPORT int Jim_PackageRequire (Jim_Interp *interp, const char *name, int flags); +#define Jim_PackageProvideCheck(INTERP, NAME) \ + if (Jim_CheckAbiVersion(INTERP, JIM_ABI_VERSION) == JIM_ERR || Jim_PackageProvide(INTERP, NAME, "1.0", JIM_ERRMSG)) \ + return JIM_ERR /* error messages */ JIM_EXPORT void Jim_MakeErrorMessage (Jim_Interp *interp); @@ -884,6 +918,8 @@ JIM_EXPORT void Jim_HistorySetCompletion(Jim_Interp *interp, Jim_Obj *commandObj); JIM_EXPORT void Jim_HistoryAdd(const char *line); JIM_EXPORT void Jim_HistoryShow(void); +JIM_EXPORT void Jim_HistorySetMaxLen(int length); +JIM_EXPORT int Jim_HistoryGetMaxLen(void); /* Misc */ JIM_EXPORT int Jim_InitStaticExtensions(Jim_Interp *interp); diff -Nru jimtcl-0.79+dfsg0/jim-history.c jimtcl-0.81+dfsg0/jim-history.c --- jimtcl-0.79+dfsg0/jim-history.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-history.c 2021-11-27 23:06:54.000000000 +0000 @@ -65,13 +65,28 @@ return JIM_OK; } +static int history_cmd_keep(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + long len; + if (argc == 1) { + if (Jim_GetLong(interp, argv[0], &len) != JIM_OK) { + return JIM_ERR; + } + Jim_HistorySetMaxLen(len); + } + else { + Jim_SetResultInt(interp, Jim_HistoryGetMaxLen()); + } + return JIM_OK; +} + static const jim_subcmd_type history_command_table[] = { - { "getline", - "prompt ?varname?", - history_cmd_getline, + { "add", + "line", + history_cmd_add, 1, - 2, - /* Description: Reads one line from the user. Similar to gets. */ + 1, + /* Description: Adds the line to the history ands saves */ }, { "completion", "command", @@ -80,6 +95,20 @@ 1, /* Description: Sets an autocompletion callback command, or none if "" */ }, + { "getline", + "prompt ?varname?", + history_cmd_getline, + 1, + 2, + /* Description: Reads one line from the user. Similar to gets. */ + }, + { "keep", + "?count?", + history_cmd_keep, + 0, + 1, + /* Description: Set or display the max history length */ + }, { "load", "filename", history_cmd_load, @@ -94,13 +123,6 @@ 1, /* Description: Saves history to the given file */ }, - { "add", - "line", - history_cmd_add, - 1, - 1, - /* Description: Adds the line to the history ands saves */ - }, { "show", NULL, history_cmd_show, @@ -113,9 +135,7 @@ int Jim_historyInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "history", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "history"); Jim_CreateCommand(interp, "history", Jim_SubCmdProc, (void *)history_command_table, NULL); return JIM_OK; } diff -Nru jimtcl-0.79+dfsg0/jim-interactive.c jimtcl-0.81+dfsg0/jim-interactive.c --- jimtcl-0.79+dfsg0/jim-interactive.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-interactive.c 2021-11-27 23:06:54.000000000 +0000 @@ -107,6 +107,21 @@ #endif } +void Jim_HistorySetMaxLen(int length) +{ +#ifdef USE_LINENOISE + linenoiseHistorySetMaxLen(length); +#endif +} + +int Jim_HistoryGetMaxLen(void) +{ +#ifdef USE_LINENOISE + return linenoiseHistoryGetMaxLen(); +#endif + return 0; +} + #ifdef USE_LINENOISE struct JimCompletionInfo { Jim_Interp *interp; @@ -261,7 +276,10 @@ } result = Jim_GetString(Jim_GetResult(interp), &reslen); if (reslen) { - printf("%s\n", result); + if (fwrite(result, reslen, 1, stdout) == 0) { + /* nothing */ + } + putchar('\n'); } } out: diff -Nru jimtcl-0.79+dfsg0/jim-interp.c jimtcl-0.81+dfsg0/jim-interp.c --- jimtcl-0.79+dfsg0/jim-interp.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-interp.c 2021-11-27 23:06:54.000000000 +0000 @@ -42,7 +42,7 @@ static int interp_cmd_delete(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - return Jim_DeleteCommand(interp, Jim_String(argv[0])); + return Jim_DeleteCommand(interp, argv[0]); } static void JimInterpDelAlias(Jim_Interp *interp, void *privData) @@ -169,9 +169,7 @@ int Jim_interpInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "interp", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "interp"); Jim_CreateCommand(interp, "interp", JimInterpCommand, NULL, NULL); return JIM_OK; diff -Nru jimtcl-0.79+dfsg0/jimiocompat.h jimtcl-0.81+dfsg0/jimiocompat.h --- jimtcl-0.79+dfsg0/jimiocompat.h 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jimiocompat.h 2021-11-27 23:06:54.000000000 +0000 @@ -8,6 +8,7 @@ #include #include +#include #include "jimautoconf.h" #include @@ -61,19 +62,26 @@ #define HAVE_PIPE #define pipe(P) _pipe((P), 0, O_NOINHERIT) -#elif defined(HAVE_UNISTD_H) - #include - #include - #include - #include - - typedef int pidtype; - #define Jim_Errno() errno - #define JIM_BAD_PID -1 - #define JIM_NO_PID 0 + typedef struct _stat64 jim_stat_t; + #define Jim_Stat __stat64 - #ifndef HAVE_EXECVPE - #define execvpe(ARG0, ARGV, ENV) execvp(ARG0, ARGV) +#else + typedef struct stat jim_stat_t; + #define Jim_Stat stat + + #if defined(HAVE_UNISTD_H) + #include + #include + #include + + typedef int pidtype; + #define Jim_Errno() errno + #define JIM_BAD_PID -1 + #define JIM_NO_PID 0 + + #ifndef HAVE_EXECVPE + #define execvpe(ARG0, ARGV, ENV) execvp(ARG0, ARGV) + #endif #endif #endif diff -Nru jimtcl-0.79+dfsg0/jim-json.c jimtcl-0.81+dfsg0/jim-json.c --- jimtcl-0.79+dfsg0/jim-json.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-json.c 2021-11-27 23:06:54.000000000 +0000 @@ -141,7 +141,10 @@ json_schema_t container_type = JSON_OBJ; /* JSON_LIST, JSON_MIXED or JSON_OBJ */ if (state->schemaObj) { - json_schema_t list_type; + /* Don't strictly need to initialise this, but some compilers can't figure out it is always + * assigned a value below. + */ + json_schema_t list_type = JSON_STR; /* Figure out the type to use for the container */ if (type == JSMN_ARRAY) { /* If every element of the array is of the same primitive schema type (str, bool or num), @@ -415,10 +418,7 @@ int Jim_jsonInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "json", "1.0", JIM_ERRMSG) != JIM_OK) { - return JIM_ERR; - } - + Jim_PackageProvideCheck(interp, "json"); Jim_CreateCommand(interp, "json::decode", json_decode, NULL, NULL); /* Load the Tcl implementation of the json encoder if possible */ Jim_PackageRequire(interp, "jsonencode", 0); diff -Nru jimtcl-0.79+dfsg0/jim-mk.cpp jimtcl-0.81+dfsg0/jim-mk.cpp --- jimtcl-0.79+dfsg0/jim-mk.cpp 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-mk.cpp 2021-11-27 23:06:54.000000000 +0000 @@ -1569,7 +1569,7 @@ static int view_cmd_destroy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - Jim_DeleteCommand(interp, Jim_String(argv[0])); + Jim_DeleteCommand(interp, argv[0]); return JIM_OK; } @@ -1801,7 +1801,7 @@ cmd = Jim_GetCommand(interp, argv[0], 0); if (cmd && !cmd->isproc && cmd->u.native.cmdProc == JimOneShotViewSubCmdProc) - Jim_DeleteCommand(interp, Jim_String(argv[0])); + Jim_DeleteCommand(interp, argv[0]); return result; } @@ -1809,7 +1809,7 @@ static int JimViewFinalizerProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { /* We won't succeed here if the user renamed the command, and this is right */ - Jim_DeleteCommand(interp, Jim_String(argv[1])); + Jim_DeleteCommand(interp, argv[1]); return JIM_OK; } @@ -2038,7 +2038,7 @@ static int storage_cmd_close(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - return Jim_DeleteCommand(interp, Jim_String(argv[0])); + return Jim_DeleteCommand(interp, argv[0]); } /* Command table ----------------------------------------------------------- */ diff -Nru jimtcl-0.79+dfsg0/jim-namespace.c jimtcl-0.81+dfsg0/jim-namespace.c --- jimtcl-0.79+dfsg0/jim-namespace.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-namespace.c 2021-11-27 23:06:54.000000000 +0000 @@ -324,9 +324,7 @@ int Jim_namespaceInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "namespace", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "namespace"); Jim_CreateCommand(interp, "namespace", JimNamespaceCmd, NULL, NULL); Jim_CreateCommand(interp, "variable", JimVariableCmd, NULL, NULL); return JIM_OK; diff -Nru jimtcl-0.79+dfsg0/jim-package.c jimtcl-0.81+dfsg0/jim-package.c --- jimtcl-0.79+dfsg0/jim-package.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-package.c 2021-11-27 23:06:54.000000000 +0000 @@ -190,7 +190,7 @@ /* *---------------------------------------------------------------------- * - * package list + * package list|names * * Returns a list of known packages * @@ -199,7 +199,7 @@ * *---------------------------------------------------------------------- */ -static int package_cmd_list(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +static int package_cmd_names(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { Jim_HashTableIterator *htiter; Jim_HashEntry *he; @@ -236,7 +236,16 @@ { "list", NULL, - package_cmd_list, + package_cmd_names, + 0, + 0, + JIM_MODFLAG_HIDDEN + /* Description: Deprecated - Lists all known packages */ + }, + { + "names", + NULL, + package_cmd_names, 0, 0, /* Description: Lists all known packages */ diff -Nru jimtcl-0.79+dfsg0/jim-pack.c jimtcl-0.81+dfsg0/jim-pack.c --- jimtcl-0.79+dfsg0/jim-pack.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-pack.c 2021-11-27 23:06:54.000000000 +0000 @@ -290,10 +290,19 @@ return JIM_ERR; } - if (Jim_GetWide(interp, argv[3], &pos) != JIM_OK) { + if (Jim_GetWideExpr(interp, argv[3], &pos) != JIM_OK) { return JIM_ERR; } - if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) { + if (pos < 0 || (option == OPT_STR && pos % 8)) { + Jim_SetResultFormatted(interp, "bad bitoffset: %#s", argv[3]); + return JIM_ERR; + } + if (Jim_GetWideExpr(interp, argv[4], &width) != JIM_OK) { + return JIM_ERR; + } + if (width < 0 || (option == OPT_STR && width % 8) || (option != OPT_STR && width > sizeof(jim_wide) * 8) || + ((option == OPT_FLOATLE || option == OPT_FLOATBE) && width != 32 && width != 64)) { + Jim_SetResultFormatted(interp, "bad bitwidth: %#s", argv[4]); return JIM_ERR; } @@ -301,12 +310,7 @@ int len; const char *str = Jim_GetString(argv[1], &len); - if (width % 8 || pos % 8) { - Jim_SetResultString(interp, "string field is not on a byte boundary", -1); - return JIM_ERR; - } - - if (pos >= 0 && width > 0 && pos < len * 8) { + if (pos < len * 8) { if (pos + width > len * 8) { width = len * 8 - pos; } @@ -319,12 +323,7 @@ const unsigned char *str = (const unsigned char *)Jim_GetString(argv[1], &len); jim_wide result = 0; - if (width > sizeof(jim_wide) * 8) { - Jim_SetResultFormatted(interp, "int field is too wide: %#s", argv[4]); - return JIM_ERR; - } - - if (pos >= 0 && width > 0 && pos < len * 8) { + if (pos < len * 8) { if (pos + width > len * 8) { width = len * 8 - pos; } @@ -344,11 +343,8 @@ double fresult; if (width == 32) { fresult = (double) JimIntToFloat(result); - } else if (width == 64) { - fresult = JimIntToDouble(result); } else { - Jim_SetResultFormatted(interp, "float field has bad bitwidth: %#s", argv[4]); - return JIM_ERR; + fresult = JimIntToDouble(result); } Jim_SetResult(interp, Jim_NewDoubleObj(interp, fresult)); } else { @@ -391,14 +387,14 @@ return JIM_ERR; } if ((option == OPT_LE || option == OPT_BE) && - Jim_GetWide(interp, argv[2], &value) != JIM_OK) { + Jim_GetWideExpr(interp, argv[2], &value) != JIM_OK) { return JIM_ERR; } if ((option == OPT_FLOATLE || option == OPT_FLOATBE) && Jim_GetDouble(interp, argv[2], &fvalue) != JIM_OK) { return JIM_ERR; } - if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) { + if (Jim_GetWideExpr(interp, argv[4], &width) != JIM_OK) { return JIM_ERR; } if (width <= 0 || (option == OPT_STR && width % 8) || (option != OPT_STR && width > sizeof(jim_wide) * 8) || @@ -407,7 +403,7 @@ return JIM_ERR; } if (argc == 6) { - if (Jim_GetWide(interp, argv[5], &pos) != JIM_OK) { + if (Jim_GetWideExpr(interp, argv[5], &pos) != JIM_OK) { return JIM_ERR; } if (pos < 0 || (option == OPT_STR && pos % 8)) { @@ -479,10 +475,7 @@ int Jim_packInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "pack", "1.0", JIM_ERRMSG)) { - return JIM_ERR; - } - + Jim_PackageProvideCheck(interp, "pack"); Jim_CreateCommand(interp, "unpack", Jim_UnpackCmd, NULL, NULL); Jim_CreateCommand(interp, "pack", Jim_PackCmd, NULL, NULL); return JIM_OK; diff -Nru jimtcl-0.79+dfsg0/jim-posix.c jimtcl-0.81+dfsg0/jim-posix.c --- jimtcl-0.79+dfsg0/jim-posix.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-posix.c 2021-11-27 23:06:54.000000000 +0000 @@ -137,9 +137,7 @@ int Jim_posixInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "posix", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "posix"); #ifdef HAVE_FORK Jim_CreateCommand(interp, "os.fork", Jim_PosixForkCommand, NULL, NULL); #endif diff -Nru jimtcl-0.79+dfsg0/jim-readdir.c jimtcl-0.81+dfsg0/jim-readdir.c --- jimtcl-0.79+dfsg0/jim-readdir.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-readdir.c 2021-11-27 23:06:54.000000000 +0000 @@ -114,9 +114,7 @@ int Jim_readdirInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "readdir", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "readdir"); Jim_CreateCommand(interp, "readdir", Jim_ReaddirCmd, NULL, NULL); return JIM_OK; } diff -Nru jimtcl-0.79+dfsg0/jim-readline.c jimtcl-0.81+dfsg0/jim-readline.c --- jimtcl-0.79+dfsg0/jim-readline.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-readline.c 2021-11-27 23:06:54.000000000 +0000 @@ -65,9 +65,7 @@ int Jim_readlineInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "readline", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "readline"); Jim_CreateCommand(interp, "readline.readline", JimRlReadlineCommand, NULL, NULL); Jim_CreateCommand(interp, "readline.addhistory", JimRlAddHistoryCommand, NULL, NULL); return JIM_OK; diff -Nru jimtcl-0.79+dfsg0/jim-redis.c jimtcl-0.81+dfsg0/jim-redis.c --- jimtcl-0.79+dfsg0/jim-redis.c 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-redis.c 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,170 @@ +/* + * Simple redis interface + * + * (c) 2020 Steve Bennett + * + * See LICENSE for license details. + */ +#include +#include +#include +#include + +/** + * Recursively decode a redis reply as Tcl data structure. + */ +static Jim_Obj *jim_redis_get_result(Jim_Interp *interp, redisReply *reply) +{ + int i; + switch (reply->type) { + case REDIS_REPLY_INTEGER: + return Jim_NewIntObj(interp, reply->integer); + case REDIS_REPLY_STATUS: + case REDIS_REPLY_ERROR: + case REDIS_REPLY_STRING: + return Jim_NewStringObj(interp, reply->str, reply->len); + break; + case REDIS_REPLY_ARRAY: + { + Jim_Obj *obj = Jim_NewListObj(interp, NULL, 0); + for (i = 0; i < reply->elements; i++) { + Jim_ListAppendElement(interp, obj, jim_redis_get_result(interp, reply->element[i])); + } + return obj; + } + case REDIS_REPLY_NIL: + return Jim_NewStringObj(interp, NULL, 0); + default: + return Jim_NewStringObj(interp, "badtype", -1); + } +} + +/** + * $r readable ?script? + * - set or clear a readable script + * $r close + * - close (delete) the handle + * $r read + * - synchronously read a SUBSCRIBE response (typically from within readable) + * $r ... + * - invoke the redis command and return the decoded result + */ +static int jim_redis_subcmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + redisContext *c = Jim_CmdPrivData(interp); + const char **args; + size_t *arglens; + int ret = JIM_OK; + + redisReply *reply; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?"); + return JIM_ERR; + } + + if (Jim_CompareStringImmediate(interp, argv[1], "readable")) { + /* Remove any existing handler */ + Jim_DeleteFileHandler(interp, c->fd, JIM_EVENT_READABLE); + if (argc > 2) { + Jim_CreateScriptFileHandler(interp, c->fd, JIM_EVENT_READABLE, argv[2]); + } + return JIM_OK; + } + if (Jim_CompareStringImmediate(interp, argv[1], "close")) { + return Jim_DeleteCommand(interp, argv[0]); + } + if (Jim_CompareStringImmediate(interp, argv[1], "read")) { + if (redisGetReply(c, (void **)&reply) != REDIS_OK) { + reply = NULL; + } + } + else { + int nargs = argc - 1; + args = Jim_Alloc(sizeof(*args) * nargs); + arglens = Jim_Alloc(sizeof(*arglens) * nargs); + for (i = 0; i < nargs; i++) { + args[i] = Jim_String(argv[i + 1]); + arglens[i] = Jim_Length(argv[i + 1]); + } + reply = redisCommandArgv(c, nargs, args, arglens); + Jim_Free(args); + Jim_Free(arglens); + } + /* sometimes commands return NULL */ + if (reply) { + Jim_SetResult(interp, jim_redis_get_result(interp, reply)); + if (reply->type == REDIS_REPLY_ERROR) { + ret = JIM_ERR; + } + freeReplyObject(reply); + } + else if (c->err) { + Jim_SetResultFormatted(interp, "%#s: %s", argv[1], c->errstr); + ret = JIM_ERR; + } + return ret; +} + +static void jim_redis_del_proc(Jim_Interp *interp, void *privData) +{ + redisContext *c = privData; + JIM_NOTUSED(interp); + Jim_DeleteFileHandler(interp, c->fd, JIM_EVENT_READABLE); + redisFree(c); +} + +/** + * redis + * + * Returns a handle that can be used to communicate with the redis + * instance over the socket. + * The original socket handle is closed. + */ +static int jim_redis_cmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + redisContext *c; + char buf[60]; + Jim_Obj *objv[2]; + long fd; + int ret; + + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "socket-stream"); + return JIM_ERR; + } + + /* Invoke getfd to get the file descriptor */ + objv[0] = argv[1]; + objv[1] = Jim_NewStringObj(interp, "getfd", -1); + ret = Jim_EvalObjVector(interp, 2, objv); + if (ret == JIM_OK) { + ret = Jim_GetLong(interp, Jim_GetResult(interp), &fd) == JIM_ERR; + } + if (ret != JIM_OK) { + Jim_SetResultFormatted(interp, "%#s: not a valid stream handle: %#s", argv[0], argv[1]); + return ret; + } + + /* Note that we dup the file descriptor here so that we can close the original */ + fd = dup(fd); + /* Can't fail */ + c = redisConnectFd(fd); + /* Now delete the original stream */ + Jim_DeleteCommand(interp, argv[1]); + snprintf(buf, sizeof(buf), "redis.handle%ld", Jim_GetId(interp)); + Jim_CreateCommand(interp, buf, jim_redis_subcmd, c, jim_redis_del_proc); + + Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); + + return JIM_OK; +} + +int +Jim_redisInit(Jim_Interp *interp) +{ + Jim_PackageProvideCheck(interp, "redis"); + Jim_CreateCommand(interp, "redis", jim_redis_cmd, NULL, NULL); + return JIM_OK; +} diff -Nru jimtcl-0.79+dfsg0/jim-regexp.c jimtcl-0.81+dfsg0/jim-regexp.c --- jimtcl-0.79+dfsg0/jim-regexp.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-regexp.c 2021-11-27 23:06:54.000000000 +0000 @@ -53,13 +53,17 @@ #include "jimregexp.h" #else #include + #define jim_regcomp regcomp + #define jim_regexec regexec + #define jim_regerror regerror + #define jim_regfree regfree #endif #include "jim.h" #include "utf8.h" static void FreeRegexpInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) { - regfree(objPtr->internalRep.ptrIntValue.ptr); + jim_regfree(objPtr->internalRep.ptrIntValue.ptr); Jim_Free(objPtr->internalRep.ptrIntValue.ptr); } @@ -94,12 +98,12 @@ pattern = Jim_String(objPtr); compre = Jim_Alloc(sizeof(regex_t)); - if ((ret = regcomp(compre, pattern, REG_EXTENDED | flags)) != 0) { + if ((ret = jim_regcomp(compre, pattern, REG_EXTENDED | flags)) != 0) { char buf[100]; - regerror(ret, compre, buf, sizeof(buf)); + jim_regerror(ret, compre, buf, sizeof(buf)); Jim_SetResultFormatted(interp, "couldn't compile regular expression pattern: %s", buf); - regfree(compre); + jim_regfree(compre); Jim_Free(compre); return NULL; } @@ -237,11 +241,11 @@ } next_match: - match = regexec(regex, source_str, num_vars + 1, pmatch, eflags); + match = jim_regexec(regex, source_str, num_vars + 1, pmatch, eflags); if (match >= REG_BADPAT) { char buf[100]; - regerror(match, regex, buf, sizeof(buf)); + jim_regerror(match, regex, buf, sizeof(buf)); Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf); result = JIM_ERR; goto done; @@ -457,12 +461,12 @@ n = source_len - offset; p = source_str + offset; do { - int match = regexec(regex, p, MAX_SUB_MATCHES, pmatch, regexec_flags); + int match = jim_regexec(regex, p, MAX_SUB_MATCHES, pmatch, regexec_flags); if (match >= REG_BADPAT) { char buf[100]; - regerror(match, regex, buf, sizeof(buf)); + jim_regerror(match, regex, buf, sizeof(buf)); Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf); return JIM_ERR; } @@ -540,7 +544,14 @@ n--; } - regexec_flags |= REG_NOTBOL; + if (pmatch[0].rm_eo == pmatch[0].rm_so) { + /* The match did not advance the string, so set REG_NOTBOL to force the next match */ + regexec_flags = REG_NOTBOL; + } + else { + regexec_flags = 0; + } + } while (n); /* @@ -570,9 +581,7 @@ int Jim_regexpInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "regexp", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "regexp"); Jim_CreateCommand(interp, "regexp", Jim_RegexpCmd, NULL, NULL); Jim_CreateCommand(interp, "regsub", Jim_RegsubCmd, NULL, NULL); return JIM_OK; diff -Nru jimtcl-0.79+dfsg0/jimregexp.c jimtcl-0.81+dfsg0/jimregexp.c --- jimtcl-0.79+dfsg0/jimregexp.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jimregexp.c 2021-11-27 23:06:54.000000000 +0000 @@ -231,7 +231,7 @@ * Beware that the optimization-preparation code in here knows about some * of the structure of the compiled regexp. */ -int regcomp(regex_t *preg, const char *exp, int cflags) +int jim_regcomp(regex_t *preg, const char *exp, int cflags) { int scan; int longest; @@ -719,7 +719,7 @@ pattern++; } - while (*pattern && *pattern != ']') { + while (*pattern != ']') { /* Is this a range? a-z */ int start; int end; @@ -731,6 +731,11 @@ }; int cc; + if (!*pattern) { + preg->err = REG_ERR_UNMATCHED_BRACKET; + return 0; + } + pattern += reg_utf8_tounicode_case(pattern, &start, nocase); if (start == '\\') { /* First check for class shorthand escapes */ @@ -754,6 +759,10 @@ preg->err = REG_ERR_NULL_CHAR; return 0; } + if (start == '\\' && *pattern == 0) { + preg->err = REG_ERR_INVALID_ESCAPE; + return 0; + } } if (pattern[0] == '-' && pattern[1] && pattern[1] != ']') { /* skip '-' */ @@ -765,6 +774,10 @@ preg->err = REG_ERR_NULL_CHAR; return 0; } + if (start == '\\' && *pattern == 0) { + preg->err = REG_ERR_INVALID_ESCAPE; + return 0; + } } reg_addrange(preg, start, end); @@ -869,7 +882,7 @@ ch = *preg->regparse++; switch (ch) { case '\0': - preg->err = REG_ERR_TRAILING_BACKSLASH; + preg->err = REG_ERR_INVALID_ESCAPE; return 0; case 'A': ret = regnode(preg, BOLX); @@ -1101,7 +1114,7 @@ /* - regexec - match a regexp against a string */ -int regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags) +int jim_regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags) { const char *s; int scan; @@ -1582,6 +1595,8 @@ } return(1); } + /* Restore input position after failure */ + preg->reginput = save; return(0); } return REG_ERR_INTERNAL; @@ -1854,7 +1869,7 @@ } #endif /* JIM_BOOTSTRAP */ -size_t regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size) +size_t jim_regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size) { static const char *error_strings[] = { "success", @@ -1873,9 +1888,10 @@ "nested count", "internal error", "count follows nothing", - "trailing backslash", + "invalid escape \\ sequence", "corrupted program", "contains null char", + "brackets [] not balanced", }; const char *err; @@ -1889,7 +1905,7 @@ return snprintf(errbuf, errbuf_size, "%s", err); } -void regfree(regex_t *preg) +void jim_regfree(regex_t *preg) { free(preg->program); } diff -Nru jimtcl-0.79+dfsg0/jimregexp.h jimtcl-0.81+dfsg0/jimregexp.h --- jimtcl-0.79+dfsg0/jimregexp.h 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jimregexp.h 2021-11-27 23:06:54.000000000 +0000 @@ -91,16 +91,17 @@ REG_ERR_NESTED_COUNT, REG_ERR_INTERNAL, REG_ERR_COUNT_FOLLOWS_NOTHING, - REG_ERR_TRAILING_BACKSLASH, + REG_ERR_INVALID_ESCAPE, REG_ERR_CORRUPTED, REG_ERR_NULL_CHAR, + REG_ERR_UNMATCHED_BRACKET, REG_ERR_NUM }; -int regcomp(regex_t *preg, const char *regex, int cflags); -int regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags); -size_t regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size); -void regfree(regex_t *preg); +int jim_regcomp(regex_t *preg, const char *regex, int cflags); +int jim_regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags); +size_t jim_regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size); +void jim_regfree(regex_t *preg); #ifdef __cplusplus } diff -Nru jimtcl-0.79+dfsg0/jim-sdl.c jimtcl-0.81+dfsg0/jim-sdl.c --- jimtcl-0.79+dfsg0/jim-sdl.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-sdl.c 2021-11-27 23:06:54.000000000 +0000 @@ -36,16 +36,34 @@ #include #include #include +#include #include +#if SDL_MAJOR_VERSION == 2 +#include +#ifdef HAVE_PKG_SDL2_TTF +#include +#endif +#else #include +#endif #include +#include -#define AIO_CMD_LEN 128 +static int jim_sdl_initialised; typedef struct JimSdlSurface { +#if SDL_MAJOR_VERSION == 2 + SDL_Window *win; + SDL_Renderer *screen; + SDL_Texture *texture; +#ifdef HAVE_PKG_SDL2_TTF + TTF_Font *font; +#endif +#else SDL_Surface *screen; +#endif } JimSdlSurface; static void JimSdlSetError(Jim_Interp *interp) @@ -59,189 +77,465 @@ JIM_NOTUSED(interp); +#if SDL_MAJOR_VERSION == 2 + SDL_DestroyRenderer(jss->screen); + SDL_DestroyWindow(jss->win); +#ifdef HAVE_PKG_SDL2_TTF + if (jss->font) { + TTF_CloseFont(jss->font); + } +#endif +#else SDL_FreeSurface(jss->screen); +#endif Jim_Free(jss); } -/* Calls to commands created via [sdl.surface] are implemented by this - * C command. */ -static int JimSdlHandlerCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +static int JimSdlGetLongs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, long *dest) { - JimSdlSurface *jss = Jim_CmdPrivData(interp); - int option; - static const char * const options[] = { - "free", "flip", "pixel", "rectangle", "box", "line", "aaline", - "circle", "aacircle", "fcircle", NULL - }; - enum - { OPT_FREE, OPT_FLIP, OPT_PIXEL, OPT_RECTANGLE, OPT_BOX, OPT_LINE, - OPT_AALINE, OPT_CIRCLE, OPT_AACIRCLE, OPT_FCIRCLE - }; - - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "method ?args ...?"); - return JIM_ERR; - } - if (Jim_GetEnum(interp, argv[1], options, &option, "SDL surface method", JIM_ERRMSG) != JIM_OK) - return JIM_ERR; - if (option == OPT_PIXEL) { - /* PIXEL */ - long x, y, red, green, blue, alpha = 255; - - if (argc != 7 && argc != 8) { - Jim_WrongNumArgs(interp, 2, argv, "x y red green blue ?alpha?"); + while (argc) { + jim_wide w; + if (Jim_GetWideExpr(interp, *argv, &w) != JIM_OK) { return JIM_ERR; } - if (Jim_GetLong(interp, argv[2], &x) != JIM_OK || - Jim_GetLong(interp, argv[3], &y) != JIM_OK || - Jim_GetLong(interp, argv[4], &red) != JIM_OK || - Jim_GetLong(interp, argv[5], &green) != JIM_OK || - Jim_GetLong(interp, argv[6], &blue) != JIM_OK) { - return JIM_ERR; - } - if (argc == 8 && Jim_GetLong(interp, argv[7], &alpha) != JIM_OK) - return JIM_ERR; - pixelRGBA(jss->screen, x, y, red, green, blue, alpha); - return JIM_OK; + *dest++ = w; + argc--; + argv++; } - else if (option == OPT_RECTANGLE || option == OPT_BOX || - option == OPT_LINE || option == OPT_AALINE) { - /* RECTANGLE, BOX, LINE, AALINE */ - long x1, y1, x2, y2, red, green, blue, alpha = 255; + return JIM_OK; +} - if (argc != 9 && argc != 10) { - Jim_WrongNumArgs(interp, 2, argv, "x y red green blue ?alpha?"); - return JIM_ERR; - } - if (Jim_GetLong(interp, argv[2], &x1) != JIM_OK || - Jim_GetLong(interp, argv[3], &y1) != JIM_OK || - Jim_GetLong(interp, argv[4], &x2) != JIM_OK || - Jim_GetLong(interp, argv[5], &y2) != JIM_OK || - Jim_GetLong(interp, argv[6], &red) != JIM_OK || - Jim_GetLong(interp, argv[7], &green) != JIM_OK || - Jim_GetLong(interp, argv[8], &blue) != JIM_OK) { - return JIM_ERR; - } - if (argc == 10 && Jim_GetLong(interp, argv[9], &alpha) != JIM_OK) - return JIM_ERR; - switch (option) { - case OPT_RECTANGLE: - rectangleRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha); - break; - case OPT_BOX: - boxRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha); - break; - case OPT_LINE: - lineRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha); - break; - case OPT_AALINE: - aalineRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha); - break; - } - return JIM_OK; - } - else if (option == OPT_CIRCLE || option == OPT_AACIRCLE || option == OPT_FCIRCLE) { - /* CIRCLE, AACIRCLE, FCIRCLE */ - long x, y, radius, red, green, blue, alpha = 255; +static void JimSdlClear(JimSdlSurface *jss, int r, int g, int b, int alpha) +{ +#if SDL_MAJOR_VERSION == 2 + SDL_SetRenderDrawColor(jss->screen, r, g, b, alpha); + SDL_RenderClear(jss->screen); +#else + SDL_FillRect(jss->screen, NULL, SDL_MapRGBA(jss->screen->format, r, g, b, alpha)); +#endif +} - if (argc != 8 && argc != 9) { - Jim_WrongNumArgs(interp, 2, argv, "x y radius red green blue ?alpha?"); - return JIM_ERR; - } - if (Jim_GetLong(interp, argv[2], &x) != JIM_OK || - Jim_GetLong(interp, argv[3], &y) != JIM_OK || - Jim_GetLong(interp, argv[4], &radius) != JIM_OK || - Jim_GetLong(interp, argv[5], &red) != JIM_OK || - Jim_GetLong(interp, argv[6], &green) != JIM_OK || - Jim_GetLong(interp, argv[7], &blue) != JIM_OK) { - return JIM_ERR; - } - if (argc == 9 && Jim_GetLong(interp, argv[8], &alpha) != JIM_OK) - return JIM_ERR; - switch (option) { - case OPT_CIRCLE: - circleRGBA(jss->screen, x, y, radius, red, green, blue, alpha); - break; - case OPT_AACIRCLE: - aacircleRGBA(jss->screen, x, y, radius, red, green, blue, alpha); - break; - case OPT_FCIRCLE: - filledCircleRGBA(jss->screen, x, y, radius, red, green, blue, alpha); - break; - } - return JIM_OK; - } - else if (option == OPT_FREE) { - /* FREE */ - if (argc != 2) { - Jim_WrongNumArgs(interp, 2, argv, ""); - return JIM_ERR; +/* Process the event loop, throwing away all events except quit. + * On quit, return JIM_EXIT. + * If necessary, this can be caught with catch -exit { ... } + */ +static int JimSdlPoll(Jim_Interp *interp) +{ + SDL_Event e; + while (SDL_PollEvent(&e)) { + if (e.type == SDL_QUIT) { + Jim_SetResultInt(interp, 0); + return JIM_EXIT; } - Jim_DeleteCommand(interp, Jim_String(argv[0])); - return JIM_OK; } - else if (option == OPT_FLIP) { - /* FLIP */ - if (argc != 2) { - Jim_WrongNumArgs(interp, 2, argv, ""); - return JIM_ERR; + return JIM_OK; +} + +static int jim_sdl_subcmd_free(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_DeleteCommand(interp, argv[0]); + return JIM_OK; +} + +/* [sdl flip] - present the current image, clear the new image, poll for events. + * Returns JIM_EXIT on quit event + */ +static int jim_sdl_subcmd_flip(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); +#if SDL_MAJOR_VERSION == 2 + SDL_RenderPresent(jss->screen); +#else + SDL_Flip(jss->screen); +#endif + JimSdlClear(jss, 0, 0, 0, SDL_ALPHA_OPAQUE); + + return JimSdlPoll(interp); +} + +/* [sdl poll ?script?] - present the current image, poll for events. + * Returns JIM_EXIT on quit event or JIM_OK if all events processed. + * + * If the script is given, evaluates the script on each poll loop until + * either quit event is received or the script returns something other than JIM_OK. + */ +static int jim_sdl_subcmd_poll(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int ret = JIM_OK; +#if SDL_MAJOR_VERSION == 2 + JimSdlSurface *jss = Jim_CmdPrivData(interp); + SDL_RenderPresent(jss->screen); +#endif + while (ret == JIM_OK) { + ret = JimSdlPoll(interp); + if (ret != JIM_OK || argc != 1) { + break; } - SDL_Flip(jss->screen); - return JIM_OK; + ret = Jim_EvalObj(interp, argv[0]); + } + return ret; +} + +static int jim_sdl_subcmd_clear(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[4]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { + return JIM_ERR; + } + if (argc == 3) { + vals[3] = SDL_ALPHA_OPAQUE; } + JimSdlClear(jss, vals[0], vals[1], vals[2], vals[3]); return JIM_OK; } -static int JimSdlSurfaceCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +static int jim_sdl_subcmd_pixel(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - JimSdlSurface *jss; - char buf[AIO_CMD_LEN]; - Jim_Obj *objPtr; - long screenId, xres, yres; - SDL_Surface *screen; + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[6]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { + return JIM_ERR; + } + if (argc == 5) { + vals[5] = SDL_ALPHA_OPAQUE; + } + pixelRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5]); + return JIM_OK; +} - if (argc != 3) { - Jim_WrongNumArgs(interp, 1, argv, "xres yres"); +static int jim_sdl_subcmd_circle(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[7]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { return JIM_ERR; } - if (Jim_GetLong(interp, argv[1], &xres) != JIM_OK || - Jim_GetLong(interp, argv[2], &yres) != JIM_OK) + if (argc == 6) { + vals[6] = SDL_ALPHA_OPAQUE; + } + circleRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6]); + return JIM_OK; +} + +static int jim_sdl_subcmd_aacircle(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[7]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { return JIM_ERR; + } + if (argc == 6) { + vals[6] = SDL_ALPHA_OPAQUE; + } + aacircleRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6]); + return JIM_OK; +} - /* Try to create the surface */ - screen = SDL_SetVideoMode(xres, yres, 32, SDL_SWSURFACE | SDL_ANYFORMAT); - if (screen == NULL) { - JimSdlSetError(interp); +static int jim_sdl_subcmd_fcircle(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[7]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { + return JIM_ERR; + } + if (argc == 6) { + vals[6] = SDL_ALPHA_OPAQUE; + } + filledCircleRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6]); + return JIM_OK; +} + +static int jim_sdl_subcmd_rectangle(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[8]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { + return JIM_ERR; + } + if (argc == 7) { + vals[7] = SDL_ALPHA_OPAQUE; + } + rectangleRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6], vals[7]); + return JIM_OK; +} + +static int jim_sdl_subcmd_box(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[8]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { return JIM_ERR; } - /* Get the next file id */ - if (Jim_EvalGlobal(interp, "if {[catch {incr sdl.surfaceId}]} {set sdl.surfaceId 0}") != JIM_OK) + if (argc == 7) { + vals[7] = SDL_ALPHA_OPAQUE; + } + boxRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6], vals[7]); + return JIM_OK; +} + +static int jim_sdl_subcmd_line(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[8]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { return JIM_ERR; - objPtr = Jim_GetVariableStr(interp, "sdl.surfaceId", JIM_ERRMSG); - if (objPtr == NULL) + } + if (argc == 7) { + vals[7] = SDL_ALPHA_OPAQUE; + } + lineRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6], vals[7]); + return JIM_OK; +} + +static int jim_sdl_subcmd_aaline(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[8]; + if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) { return JIM_ERR; - if (Jim_GetLong(interp, objPtr, &screenId) != JIM_OK) + } + if (argc == 7) { + vals[7] = SDL_ALPHA_OPAQUE; + } + aalineRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6], vals[7]); + return JIM_OK; +} + +#ifdef HAVE_PKG_SDL2_TTF +static int jim_sdl_subcmd_font(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long size; + + if (Jim_GetLong(interp, argv[1], &size) != JIM_OK) { + return JIM_ERR; + } + if (jss->font) { + TTF_CloseFont(jss->font); + } + else { + TTF_Init(); + } + jss->font = TTF_OpenFont(Jim_String(argv[0]), size); + if (jss->font == NULL) { + Jim_SetResultFormatted(interp, "Failed to load font %#s", argv[0]); return JIM_ERR; + } + TTF_SetFontHinting(jss->font, TTF_HINTING_LIGHT); + return JIM_OK; +} - /* Create the SDL screen command */ - jss = Jim_Alloc(sizeof(*jss)); - jss->screen = screen; - sprintf(buf, "sdl.surface%ld", screenId); - Jim_CreateCommand(interp, buf, JimSdlHandlerCommand, jss, JimSdlDelProc); - Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); +static int jim_sdl_subcmd_text(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss = Jim_CmdPrivData(interp); + long vals[6]; + SDL_Surface *surface; + SDL_Texture *texture; + SDL_Rect rect; + SDL_Color col; + + if (!jss->font) { + Jim_SetResultString(interp, "No font loaded", -1); + return JIM_ERR; + } + + if (JimSdlGetLongs(interp, argc - 1, argv + 1, vals) != JIM_OK) { + return JIM_ERR; + } + col.r = vals[2]; + col.g = vals[3]; + col.b = vals[4]; + col.a = (argc == 7) ? vals[5] : SDL_ALPHA_OPAQUE; +#ifdef JIM_UTF8 + surface = TTF_RenderUTF8_Blended(jss->font, Jim_String(argv[0]), col); +#else + surface = TTF_RenderText_Blended(jss->font, Jim_String(argv[0]), col); +#endif + texture = SDL_CreateTextureFromSurface(jss->screen, surface); + rect.x = vals[0]; + rect.y = vals[1]; + rect.w = surface->w; + rect.h = surface->h; + SDL_RenderCopy(jss->screen, texture, NULL, &rect); + SDL_DestroyTexture(texture); + SDL_FreeSurface(surface); return JIM_OK; } +#endif -int Jim_sdlInit(Jim_Interp *interp) +static const jim_subcmd_type sdl_command_table[] = { + { "free", + NULL, + jim_sdl_subcmd_free, + 0, + 0, + JIM_MODFLAG_FULLARGV, + }, + { "flip", + NULL, + jim_sdl_subcmd_flip, + 0, + 0, + }, + { "poll", + "?script?", + jim_sdl_subcmd_poll, + 0, + 1, + }, + { "clear", + "red green blue ?alpha?", + jim_sdl_subcmd_clear, + 3, + 4, + }, + { "pixel", + "x y red green blue ?alpha?", + jim_sdl_subcmd_pixel, + 5, + 6, + }, + { "circle", + "x y radius red green blue ?alpha?", + jim_sdl_subcmd_circle, + 6, + 7, + }, + { "aacircle", + "x y radius red green blue ?alpha?", + jim_sdl_subcmd_aacircle, + 6, + 7, + }, + { "fcircle", + "x y radius red green blue ?alpha?", + jim_sdl_subcmd_fcircle, + 6, + 7, + }, + { "rectangle", + "x1 y1 x2 y2 red green blue ?alpha?", + jim_sdl_subcmd_rectangle, + 7, + 8, + }, + { "box", + "x1 y1 x2 y2 red green blue ?alpha?", + jim_sdl_subcmd_box, + 7, + 8, + }, + { "line", + "x1 y1 x2 y2 red green blue ?alpha?", + jim_sdl_subcmd_line, + 7, + 8, + }, + { "aaline", + "x1 y1 x2 y2 red green blue ?alpha?", + jim_sdl_subcmd_aaline, + 7, + 8, + }, +#ifdef HAVE_PKG_SDL2_TTF + { "font", + "filename.ttf size", + jim_sdl_subcmd_font, + 2, + 2, + }, + { "text", + "x y string red green blue ?alpha?", + jim_sdl_subcmd_text, + 6, + 7, + }, +#endif + { NULL } +}; + +/* Calls to commands created via [sdl.surface] are implemented by this + * C command. */ +static int JimSdlHandlerCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (Jim_PackageProvide(interp, "sdl", "1.0", JIM_ERRMSG)) + const jim_subcmd_type *ct = Jim_ParseSubCmd(interp, sdl_command_table, argc, argv); + + return Jim_CallSubCmd(interp, ct, argc, argv); +} + +static int JimSdlSurfaceCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + JimSdlSurface *jss; + char buf[128]; + long vals[2]; + const char *title; + + if (argc != 3 && argc != 4) { + Jim_WrongNumArgs(interp, 1, argv, "xres yres ?title?"); return JIM_ERR; + } - if (SDL_Init(SDL_INIT_VIDEO) < 0) { + if (JimSdlGetLongs(interp, 2, argv + 1, vals) != JIM_OK) { + return JIM_ERR; + } + + if (!jim_sdl_initialised) { + jim_sdl_initialised++; + if (SDL_Init(SDL_INIT_VIDEO) < 0) { + JimSdlSetError(interp); + return JIM_ERR; + } +#if SDL_MAJOR_VERSION == 2 + SDL_SetHint(SDL_HINT_RENDER_VSYNC, "1"); + SDL_SetHint(SDL_HINT_RENDER_SCALE_QUALITY, "1"); +#endif + atexit(SDL_Quit); + } + + title = (argc == 4) ? Jim_String(argv[3]) : "sdl"; + + jss = Jim_Alloc(sizeof(*jss)); + memset(jss, 0, sizeof(*jss)); + +#if SDL_MAJOR_VERSION == 2 + /* Try to create the surface */ + jss->win = SDL_CreateWindow(title, SDL_WINDOWPOS_UNDEFINED, SDL_WINDOWPOS_UNDEFINED, vals[0], vals[1], 0); + if (jss->win) { + jss->screen = SDL_CreateRenderer(jss->win, -1, SDL_RENDERER_PRESENTVSYNC | SDL_RENDERER_ACCELERATED); + if (jss->screen) { + /* Need an initial SDL_PollEvent() to make the window display */ + SDL_PollEvent(NULL); + } + else { + SDL_DestroyWindow(jss->win); + } + } +#else + jss->screen = SDL_SetVideoMode(vals[0], vals[1], 32, SDL_SWSURFACE | SDL_ANYFORMAT); + if (jss->screen) { + SDL_WM_SetCaption(title, title); + } +#endif + if (jss->screen) { + JimSdlClear(jss, 0, 0, 0, SDL_ALPHA_OPAQUE); + } + else { JimSdlSetError(interp); + Jim_Free(jss); return JIM_ERR; } - atexit(SDL_Quit); + + /* Create the SDL command */ + snprintf(buf, sizeof(buf), "sdl.surface%ld", Jim_GetId(interp)); + Jim_CreateCommand(interp, buf, JimSdlHandlerCommand, jss, JimSdlDelProc); + Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); + return JIM_OK; +} + +int Jim_sdlInit(Jim_Interp *interp) +{ + Jim_PackageProvideCheck(interp, "sdl"); Jim_CreateCommand(interp, "sdl.screen", JimSdlSurfaceCommand, NULL, NULL); return JIM_OK; } diff -Nru jimtcl-0.79+dfsg0/jimsh.c jimtcl-0.81+dfsg0/jimsh.c --- jimtcl-0.79+dfsg0/jimsh.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jimsh.c 2021-11-27 23:06:54.000000000 +0000 @@ -128,7 +128,12 @@ JimSetArgv(interp, argc - 3, argv + 3); retcode = Jim_Eval(interp, argv[2]); if (retcode != JIM_ERR) { - printf("%s\n", Jim_String(Jim_GetResult(interp))); + int len; + const char *msg = Jim_GetString(Jim_GetResult(interp), &len); + if (fwrite(msg, len, 1, stdout) == 0) { + /* nothing */ + } + putchar('\n'); } } else { diff -Nru jimtcl-0.79+dfsg0/jim-signal.c jimtcl-0.81+dfsg0/jim-signal.c --- jimtcl-0.79+dfsg0/jim-signal.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-signal.c 2021-11-27 23:06:54.000000000 +0000 @@ -293,7 +293,7 @@ int sig = find_signal_by_name(interp, Jim_String(argv[i])); if (sig < 0 || sig >= MAX_SIGNALS) { - return -1; + return JIM_ERR; } mask |= sig_to_bit(sig); } @@ -530,9 +530,7 @@ int Jim_signalInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "signal", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "signal"); Jim_CreateCommand(interp, "alarm", Jim_AlarmCmd, 0, 0); Jim_CreateCommand(interp, "kill", Jim_KillCmd, 0, 0); /* Sleep is slightly dubious here */ diff -Nru jimtcl-0.79+dfsg0/jim-sqlite3.c jimtcl-0.81+dfsg0/jim-sqlite3.c --- jimtcl-0.79+dfsg0/jim-sqlite3.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-sqlite3.c 2021-11-27 23:06:54.000000000 +0000 @@ -155,7 +155,7 @@ Jim_WrongNumArgs(interp, 2, argv, ""); return JIM_ERR; } - Jim_DeleteCommand(interp, Jim_String(argv[0])); + Jim_DeleteCommand(interp, argv[0]); return JIM_OK; } else if (option == OPT_QUERY) { @@ -212,7 +212,7 @@ vObj = nullStrObj; break; case SQLITE_INTEGER: - vObj = Jim_NewIntObj(interp, sqlite3_column_int(stmt, i)); + vObj = Jim_NewIntObj(interp, sqlite3_column_int64(stmt, i)); break; case SQLITE_FLOAT: vObj = Jim_NewDoubleObj(interp, sqlite3_column_double(stmt, i)); @@ -288,9 +288,7 @@ int Jim_sqlite3Init(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "sqlite3", "1.0", JIM_ERRMSG)) - return JIM_ERR; - + Jim_PackageProvideCheck(interp, "sqlite3"); Jim_CreateCommand(interp, "sqlite3.open", JimSqliteOpenCommand, NULL, NULL); return JIM_OK; } diff -Nru jimtcl-0.79+dfsg0/jim-subcmd.c jimtcl-0.81+dfsg0/jim-subcmd.c --- jimtcl-0.79+dfsg0/jim-subcmd.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-subcmd.c 2021-11-27 23:06:54.000000000 +0000 @@ -26,30 +26,49 @@ "dummy", NULL, subcmd_null, 0, 0, JIM_MODFLAG_HIDDEN }; -static void add_commands(Jim_Interp *interp, const jim_subcmd_type * ct, const char *sep) +/* Creates and returns a string (object) of each non-hidden command in 'ct', + * sorted and separated with the given separator string. + * + * For example, if there are two commands, "def" and "abc", with a separator of "; ", + * the returned string will be "abc; def" + * + * The returned object has a reference count of 0. + */ +static Jim_Obj *subcmd_cmd_list(Jim_Interp *interp, const jim_subcmd_type * ct, const char *sep) { - const char *s = ""; + /* Create a list to sort before joining */ + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + Jim_Obj *sortCmd[2]; for (; ct->cmd; ct++) { if (!(ct->flags & JIM_MODFLAG_HIDDEN)) { - Jim_AppendStrings(interp, Jim_GetResult(interp), s, ct->cmd, NULL); - s = sep; + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, ct->cmd, -1)); } } + + /* There is no direct API to sort a list, so just invoke lsort here. */ + sortCmd[0] = Jim_NewStringObj(interp, "lsort", -1); + sortCmd[1] = listObj; + /* Leaves the result in the interpreter result */ + if (Jim_EvalObjVector(interp, 2, sortCmd) == JIM_OK) { + return Jim_ListJoin(interp, Jim_GetResult(interp), sep, strlen(sep)); + } + /* lsort can't really fail (normally), but if it does, just return the error as the result */ + return Jim_GetResult(interp); } static void bad_subcmd(Jim_Interp *interp, const jim_subcmd_type * command_table, const char *type, Jim_Obj *cmd, Jim_Obj *subcmd) { - Jim_SetResultFormatted(interp, "%#s, %s command \"%#s\": should be ", cmd, type, subcmd); - add_commands(interp, command_table, ", "); + Jim_SetResultFormatted(interp, "%#s, %s command \"%#s\": should be %#s", cmd, type, + subcmd, subcmd_cmd_list(interp, command_table, ", ")); } static void show_cmd_usage(Jim_Interp *interp, const jim_subcmd_type * command_table, int argc, Jim_Obj *const *argv) { - Jim_SetResultFormatted(interp, "Usage: \"%#s command ... \", where command is one of: ", argv[0]); - add_commands(interp, command_table, ", "); + Jim_SetResultFormatted(interp, "Usage: \"%#s command ... \", where command is one of: %#s", + argv[0], subcmd_cmd_list(interp, command_table, ", ")); } static void add_cmd_usage(Jim_Interp *interp, const jim_subcmd_type * ct, Jim_Obj *cmd) @@ -123,9 +142,7 @@ /* Check for special builtin '-commands' command first */ if (Jim_CompareStringImmediate(interp, cmd, "-commands")) { - /* Build the result here */ - Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); - add_commands(interp, command_table, " "); + Jim_SetResult(interp, subcmd_cmd_list(interp, command_table, " ")); return &dummy_subcmd; } diff -Nru jimtcl-0.79+dfsg0/jim-syslog.c jimtcl-0.81+dfsg0/jim-syslog.c --- jimtcl-0.79+dfsg0/jim-syslog.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-syslog.c 2021-11-27 23:06:54.000000000 +0000 @@ -172,8 +172,7 @@ { SyslogInfo *info; - if (Jim_PackageProvide(interp, "syslog", "1.0", JIM_ERRMSG)) - return JIM_ERR; + Jim_PackageProvideCheck(interp, "syslog"); info = Jim_Alloc(sizeof(*info)); diff -Nru jimtcl-0.79+dfsg0/jim-tclprefix.c jimtcl-0.81+dfsg0/jim-tclprefix.c --- jimtcl-0.79+dfsg0/jim-tclprefix.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-tclprefix.c 2021-11-27 23:06:54.000000000 +0000 @@ -28,6 +28,32 @@ return maxlen; } +/* + * Like Jim_StringCompareObj() except only matches as much as the length of firstObjPtr. + * So "abc" matches "abcdef" but "abcdef" does not match "abc". + */ +int JimStringComparePrefix(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr) +{ + /* We do this the easy way by creating a (possibly) shorter version of secondObjPtr */ + int l1 = Jim_Utf8Length(interp, firstObjPtr); + const char *s2 = Jim_String(secondObjPtr); + int l2 = Jim_Utf8Length(interp, secondObjPtr); + Jim_Obj *objPtr; + int ret; + + if (l2 > l1) { + objPtr = Jim_NewStringObjUtf8(interp, s2, l1); + } + else { + objPtr = secondObjPtr; + } + Jim_IncrRefCount(objPtr); + + ret = Jim_StringCompareObj(interp, firstObjPtr, objPtr, 0); + Jim_DecrRefCount(interp, objPtr); + return ret; +} + /* [tcl::prefix] */ static int Jim_TclPrefixCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) @@ -140,7 +166,7 @@ objPtr = Jim_NewListObj(interp, NULL, 0); for (i = 0; i < listlen; i++) { Jim_Obj *valObj = Jim_ListGetIndex(interp, argv[2], i); - if (Jim_StringCompareLenObj(interp, argv[3], valObj, 0) == 0) { + if (JimStringComparePrefix(interp, argv[3], valObj) == 0) { Jim_ListAppendElement(interp, objPtr, valObj); } } @@ -164,7 +190,7 @@ for (i = 0; i < listlen; i++) { Jim_Obj *valObj = Jim_ListGetIndex(interp, argv[2], i); - if (Jim_StringCompareLenObj(interp, stringObj, valObj, 0)) { + if (JimStringComparePrefix(interp, stringObj, valObj)) { /* Does not begin with 'string' */ continue; } @@ -188,10 +214,7 @@ int Jim_tclprefixInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "tclprefix", "1.0", JIM_ERRMSG)) { - return JIM_ERR; - } - + Jim_PackageProvideCheck(interp, "tclprefix"); Jim_CreateCommand(interp, "tcl::prefix", Jim_TclPrefixCoreCommand, NULL, NULL); return JIM_OK; } diff -Nru jimtcl-0.79+dfsg0/jim_tcl.txt jimtcl-0.81+dfsg0/jim_tcl.txt --- jimtcl-0.79+dfsg0/jim_tcl.txt 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim_tcl.txt 2021-11-27 23:06:54.000000000 +0000 @@ -3,7 +3,7 @@ NAME ---- -Jim Tcl v0.79 - reference manual for the Jim Tcl scripting language +Jim Tcl v0.81 - reference manual for the Jim Tcl scripting language SYNOPSIS -------- @@ -31,7 +31,7 @@ a significant subset of the Tcl 8.6 command set, plus additional features available only in Jim Tcl. -Some notable differences with Tcl 8.5/8.6 are: +Some notable differences with Tcl 8.5/8.6/8.7 are: 1. Object-based I/O (aio), but with a Tcl-compatibility layer 2. I/O: Support for sockets and pipes including udp, unix domain sockets and IPv6 @@ -52,6 +52,31 @@ RECENT CHANGES -------------- +Changes between 0.80 and 0.81 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +1. TIP 582, comments allowed in expressions +2. Many commands now accept "safe" integer expressions rather than simple integers: + `loop`, `range`, `incr`, `string repeat`, `lrepeat`, `pack`, `unpack`, `rand` +3. String and list indexes now accept integer expressions (<<_string_and_list_index_specifications,STRING AND LIST INDEX SPECIFICATIONS>>) +4. `loop` can now omit the start value +5. Add the `xtrace` command for execution trace support +6. Add `history keep` +7. Add support for `lsearch -index` and `lsearch -stride`, the latter per TIP 351 +8. `lsort -index` now supports multiple indices +9. Add support for `lsort -stride` +10. `open` now supports POSIX-style access arguments +11. TIP 526, `expr` now only allows a single argument (unless --compat is enabled) + +Changes between 0.79 and 0.80 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +1. `regsub` now fully supports +{backslash}A+ +2. Add `socket pty` to create a pseudo-tty pair +3. Null characters (\x00) are now supported in variable and proc names +4. dictionaries and arrays now preserve insertion order, matching Tcl and the documentation +5. Add `dict getwithdefault` (and the alias `dict getdef`) per TIP 342 +6. Add string comparison operators (lt, gt, le, ge) per TIP 461 +7. Implement 0d radix prefix for decimal per TIP 472 + Changes between 0.78 and 0.79 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1. Add `file mtimeus` for high resolution file timestamps @@ -638,20 +663,32 @@ The index may be one of the following forms: +integer+:: - A simple integer, where '0' refers to the first element of the string + A simple integer, where +0+ refers to the first element of the string or list. -+integer+integer+ or:: -+integer-integer+:: - The sum or difference of the two integers. e.g. +2+3+ refers to the 5th element. - This is useful when used with (e.g.) +$i+1+ rather than the more verbose - +[expr {$i+1\}]+ ++integerexpression+:: + Any "safe" expression that evaluates to an integer. A "safe" expression does not perform + variable or command subsitution, but is otherwise like a normal expression + (see <<_expressions,EXPRESSIONS>>). + + :: + For example +1+2*3+ is valid integer expression, but +{$x*2-1}+ is not. + But note that it is possible to use an unbraced expression to allow the Tcl interpreter + to expand variables and commands before being parsed as an integer expression. + + :: + e.g. +string repeat a $x*2-1+ -+end+:: ++*end*+:: The last element of the string or list. -+end-integer+:: - The 'nth-from-last' element of the string or list. ++*end*-integer+:: ++*end*-integerexpression+:: ++*end*+integerexpression+:: + The 'nth-from-last' element of the string or list. Again, a "safe" integer expression + may be used in place of a simple integer. +end-3+ or +end-3+2*$n+. Normally it only makes + sense to use the +*end*-+ form, but if the integer expression is negative, the +*end*++ form + may be used. COMMAND SUMMARY --------------- @@ -715,9 +752,13 @@ parentheses; it is ignored by the expression processor. Where possible, operands are interpreted as integer values. -Integer values may be specified in decimal (the normal case) or in -hexadecimal (if the first two characters of the operand are '0x'). -Note that Jim Tcl does *not* treat numbers with leading zeros as octal. +Comments are allowed in expressions, beginning with the '#' character +and continuing until the end of line or end of expression. + +Integer values are interpreted as decimal, binary, octal or +hexadecimal if prepended with '0d', '0b', '0o' or '0x' +respectively. Otherwise they are interpreted as decimal by default. +(Jim Tcl does not interpret numbers with leading zeros as octal.) If an operand does not have one of the integer formats given above, then it is treated as a floating-point number if that is @@ -822,6 +863,12 @@ These operators may be applied to strings as well as numeric operands, in which case string comparison is used. ++lt gt le ge+:: + Boolean less, greater, less than or equal, and greater than or equal. + Each operator produces 1 if the condition is true, 0 otherwise. + These operators differ from the above in that they use string comparison + for all operands, including numeric. + +== !=+:: Boolean equal and not equal. Each operator produces a zero/one result. Valid for all operand types. *Note* that values will be converted to integers @@ -1052,7 +1099,7 @@ REGULAR EXPRESSIONS ------------------- -Tcl provides two commands that support string matching using regular +Jim Tcl provides two commands that support string matching using regular expressions, `regexp` and `regsub`, as well as `switch -regexp` and `lsearch -regexp`. @@ -1088,12 +1135,39 @@ 2. All Tcl character classes are supported (e.g. +[:alnum:]+, +[:digit:]+, +[:space:]+), but... 3. Character classes apply to ASCII characters only 4. Supported shorthand character classes: +{backslash}w+ = +[:alnum:]+, +{backslash}W+ = +^[:alnum:]+, +{backslash}d+ = +[:digit:],+ +{backslash}D+ = +^[:digit:],+ +{backslash}s+ = +[:space:]+, + +{backslash}S+ = +^[:space:]+ -5. Supported constraint escapes: +{backslash}m+ = +{backslash}<+ = start of word, +{backslash}M+ = +{backslash}>+ = end of word +5. Supported constraint escapes: +{backslash}m+ = +{backslash}<+ = start of word, +{backslash}M+ = +{backslash}>+ = end of word, +{backslash}A+ = start of string, +{backslash}Z+ = end of string 6. Backslash escapes may be used within regular expressions, such as +{backslash}n+ = newline, +{backslash}uNNNN+ = unicode -7. Partially supported constraint escapes: +{backslash}A+ = start of string, +{backslash}Z+ = end of string -8. Support for the +?+ non-greedy quantifier. e.g. +*?+ -9. Support for non-capturing parentheses +(?:...)+ -10. Jim Tcl considers that both patterns and strings end at a null character (+\x00+) +7. Support for the +?+ non-greedy quantifier. e.g. +*?+ +8. Support for non-capturing parentheses +(?:...)+ +9. Jim Tcl considers that both patterns and strings end at a null character (+\x00+) +10. Jim Tcl does not support back references. e.g. +{backslash}1+ + +STRING MATCHING +--------------- +A number of commands in Jim support C-shell style "glob matching", including +`string match`, `switch -glob`, `array names` and others. This form of string matching +works as follows: + +A test occurs where a +'string'+ is matched against a +'pattern'+. The match is considered +successful if the contents of +'string'+ and +'pattern'+ are identical except that the +following special sequences may appear in +'pattern'+: + ++*+;; + Matches any sequence of characters in +'string'+, including an empty string. + ++?+;; + Matches any single character in +'string'+. + ++['chars']+;; + Matches any character in the set given by +'chars'+. + If a sequence of the form +'x-y'+ appears in +'chars'+, + then any character between +'x'+ and +'y'+, inclusive, + will match. + ++{backslash}x+;; + Matches the single character +'x'+. This provides a way of + avoiding the special interpretation of the characters +{backslash}*?[]+ + in +'pattern'+. COMMAND RESULTS --------------- @@ -1576,8 +1650,8 @@ String Matching ~~~~~~~~~~~~~~~ -Commands such as `string match`, `lsearch -glob`, `array names` and others use string -pattern matching rules. These commands support UTF-8. For example: +Commands such as `string match`, `lsearch -glob`, `array names` and others use +<<_string_matching,STRING MATCHING>> rules. These commands support UTF-8. For example: ---- string match a\[\ua0-\ubf\]b "a\u00a3b" @@ -1726,11 +1800,11 @@ +*apply* 'lambdaExpr ?arg1 arg2 \...?'+ The command `apply` provides for anonymous procedure calls, -similar to `lambda`, but without command name being created, even temporarily. +similar to `lambda`, but without a command name being created, even temporarily. -The function +'lambdaExpr'+ is a two element list +{args body}+ -or a three element list +{args body namespace}+. The first element -args specifies the formal arguments, in the same form as the `proc` and `lambda` commands. +The function +'lambdaExpr'+ is a two element list, +{args body}+ +or a three element list, +{args body namespace}+. The first element ++'args'+ specifies the formal arguments in the same form as the `proc` and `lambda` commands. array ~~~~~ @@ -1746,51 +1820,51 @@ command. The legal +'options'+ (which may be abbreviated) are: +*array exists* 'arrayName'+:: - Returns 1 if arrayName is an array variable, 0 if there is + Returns 1 if +'arrayName'+ is an array variable, 0 if there is no variable by that name. +*array get* 'arrayName ?pattern?'+:: Returns a list containing pairs of elements. The first - element in each pair is the name of an element in arrayName + element in each pair is the name of an element in +'arrayName'+ and the second element of each pair is the value of the array element. The order of the pairs is undefined. If - pattern is not specified, then all of the elements of the - array are included in the result. If pattern is specified, - then only those elements whose names match pattern (using - the matching rules of string match) are included. If arrayName + +'pattern'+ is not specified, then all of the elements of the + array are included in the result. If +'pattern'+ is specified, + then only those elements whose names match +'pattern'+ (using + <<_string_matching,STRING MATCHING>> rules) are included. If +'arrayName'+ isn't the name of an array variable, or if the array contains no elements, then an empty list is returned. +*array names* 'arrayName ?pattern?'+:: Returns a list containing the names of all of the elements - in the array that match pattern. If pattern is omitted then + in the array that match +'pattern'+. If +'pattern'+ is omitted then the command returns all of the element names in the array. - If pattern is specified, then only those elements whose - names match pattern (using the matching rules of string - match) are included. If there are no (matching) elements - in the array, or if arrayName isn't the name of an array + If +'pattern'+ is specified, then only those elements whose + names match +'pattern'+ (using <<_string_matching,STRING MATCHING>> rules) + are included. If there are no (matching) elements + in the array, or if +'arrayName'+ isn't the name of an array variable, then an empty string is returned. +*array set* 'arrayName list'+:: - Sets the values of one or more elements in arrayName. list + Sets the values of one or more elements in +'arrayName'+. +'list'+ must have a form like that returned by array get, consisting of an even number of elements. Each odd-numbered element in list is treated as an element name within arrayName, and the following element in list is used as a new value for - that array element. If the variable arrayName does not - already exist and list is empty, arrayName is created with + that array element. If the variable +'arrayName'+ does not + already exist and list is empty, +'arrayName'+ is created with an empty array value. +*array size* 'arrayName'+:: - Returns the number of elements in the array. If arrayName + Returns the number of elements in the array. If +'arrayName'+ isn't the name of an array then 0 is returned. +*array unset* 'arrayName ?pattern?'+:: - Unsets all of the elements in the array that match pattern - (using the matching rules of string match). If arrayName + Unsets all of the elements in the array that match +'pattern'+ + (using <<_string_matching,STRING MATCHING>> rules). If +'arrayName'+ isn't the name of an array variable or there are no matching - elements in the array, no error will be raised. If pattern - is omitted and arrayName is an array variable, then the + elements in the array, no error will be raised. If +'pattern'+ + is omitted and +'arrayName'+ is an array variable, then the command unsets the entire array. The command always returns an empty string. @@ -1894,13 +1968,16 @@ If no format is supplied, "%c" is used. :: If +'boolean'+ is true, processing is performed in UTC. - If +'boolean'+ is false (the default), processing is performeed in the local time zone. + If +'boolean'+ is false (the default), processing is performed in the local time zone. +*clock scan* 'str' *-format* 'format' ?*-gmt* 'boolean?'+:: Scan the given time string using the given format string. See strptime(3) for supported formats. See `clock format` for the handling of '-gmt'. +*NOTE* Some systems such as 32-bit Linux have only a 32-bit time_t, and are therefore not year 2038 +compliant. + close ~~~~~ +*close* 'fileId'+ @@ -2004,11 +2081,18 @@ be the value for that key. It is an error to attempt to retrieve a value for a key that is not present in the dictionary. ++*dict getdef* 'dictionary ?key \...? key default'+:: + Alias for `dict getwithdefault`. + ++*dict getwithdefault* 'dictionary ?key \...? key default'+:: + Similar to `dict get` except if no value exists in the dictionary for the + give key(s), returns +'default'+ instead. + +*dict keys* 'dictionary ?pattern?'+:: Returns a list of the keys in the dictionary. - If pattern is specified, then only those keys whose - names match +'pattern'+ (using the matching rules of string - match) are included. + If +'pattern'+ is specified, then only those keys whose + names match +'pattern'+ (using <<_string_matching,STRING MATCHING>> rules) + are included. +*dict merge* ?'dictionary \...'?+:: Return a dictionary that contains the contents of each of the @@ -2709,7 +2793,7 @@ The value of the variable must be integral. If +'increment'+ is supplied then its value (which must be an -integer) is added to the value of variable +'varName'+; otherwise +integer expression) is added to the value of variable +'varName'+; otherwise 1 is added to +'varName'+. The new value is stored as a decimal string in variable +'varName'+ @@ -2747,8 +2831,7 @@ Tcl commands, including both the built-in commands written in C and the command procedures defined using the `proc` command. If +'pattern'+ is specified, only those names matching +'pattern'+ - are returned. Matching is determined using the same rules as for - `string match`. + (using <<_string_matching,STRING MATCHING>> rules) are returned. +*info complete* 'command' ?'missing'?+:: Returns 1 if +'command'+ is a complete Tcl command in the sense of @@ -2780,8 +2863,7 @@ If +'pattern'+ isn't specified, returns a list of all the names of currently-defined global variables. If +'pattern'+ is specified, only those names matching +'pattern'+ - are returned. Matching is determined using the same rules as for - `string match`. + (using <<_string_matching,STRING MATCHING>> rules) are returned. +*info hostname*+:: An alias for `os.gethostname` for compatibility with Tcl 6.x @@ -2804,8 +2886,8 @@ of currently-defined local variables, including arguments to the current procedure, if any. Variables defined with the `global` and `upvar` commands will not be returned. If +'pattern'+ is - specified, only those names matching +'pattern'+ are returned. - Matching is determined using the same rules as for `string match`. + specified, only those names matching +'pattern'+ + (using <<_string_matching,STRING MATCHING>> rules) are returned. +*info nameofexecutable*+:: Returns the name of the binary file from which the application @@ -2816,8 +2898,7 @@ If +'pattern'+ isn't specified, returns a list of all the names of Tcl command procedures. If +'pattern'+ is specified, only those names matching +'pattern'+ - are returned. Matching is determined using the same rules as for - `string match`. + (using <<_string_matching,STRING MATCHING>> rules) are returned. +*info references*+:: Returns a list of all references which have not yet been garbage @@ -2860,8 +2941,7 @@ returns a list of all the names of currently-visible variables, including both locals and currently-visible globals. If +'pattern'+ is specified, only those names matching +'pattern'+ - are returned. Matching is determined using the same rules as for - `string match`. + (using <<_string_matching,STRING MATCHING>> rules) are returned. join ~~~~ @@ -2952,13 +3032,13 @@ +*local* 'cmd ?arg\...?'+ First, `local` evaluates +'cmd'+ with the given arguments. The return value must -be the name of an existing command, which is marked as having local scope. +be the name of an existing command, which is then marked as having local scope. This means that when the current procedure exits, the specified command is deleted. This can be useful with `lambda`, local procedures or to automatically close a filehandle. -In addition, if a command already exists with the same name, -the existing command will be kept rather than deleted, and may be called +In addition, if a the command already exists with the same name, +the existing command will be kept rather than being deleted, and may be called via `upcall`. The previous command will be restored when the current procedure exits. See `upcall` for more details. @@ -2993,21 +3073,28 @@ } ---- +Also see `defer` as another mechanism for cleaning up at the end of a procedure. + loop ~~~~ -+*loop* 'var first limit ?incr? body'+ ++*loop* 'var ?first? limit ?incr? body'+ Similar to `for` except simpler and possibly more efficient. -With a positive increment, equivalent to: +If +'incr'+ is positive, the effect is, equivalent to: ---- for {set var $first} {$var < $limit} {incr var $incr} $body ---- +While if +'incr'+ is negative, the count is downwards. + +If +'first'+ is not specified, 0 is used. If +'incr'+ is not specified, 1 is used. Note that setting the loop variable inside the loop does not affect the loop count. ++'first'+, +'limit'+ and +'incr'+ may be any integer expression. + lindex ~~~~~~ +*lindex* 'list ?index ...?'+ @@ -3079,8 +3166,7 @@ ~~~~~~~ +*llength* 'list'+ -Treats +'list'+ as a list and returns a decimal string giving -the number of elements in it. +Treats +'list'+ as a list and returns the number of elements in that list. lset ~~~~ @@ -3091,7 +3177,7 @@ The `lset` command accepts a parameter, +'varName'+, which it interprets as the name of a variable containing a Tcl list. It also accepts zero or more indices into the list. Finally, it accepts a new value -for an element of varName. If no indices are presented, the command +for an element of +'varName'+. If no indices are presented, the command takes the form: ---- @@ -3099,21 +3185,21 @@ ---- In this case, newValue replaces the old value of the variable -varName. ++'varName'+. When presented with a single index, the `lset` command -treats the content of the varName variable as a Tcl list. It addresses +treats the content of the +'varName'+ variable as a Tcl list. It addresses the index'th element in it (0 refers to the first element of the list). When interpreting the list, `lset` observes the same rules concerning braces and quotes and backslashes as the Tcl command interpreter; however, variable substitution and command substitution do not occur. The command constructs a new list in which the designated element is replaced with newValue. This new list is -stored in the variable varName, and is also the return value from +stored in the variable +'varName'+, and is also the return value from the `lset` command. If index is negative or greater than or equal to the number of -elements in $varName, then an error occurs. +elements in +$varName+, then an error occurs. See <<_string_and_list_index_specifications,STRING AND LIST INDEX SPECIFICATIONS>> for all allowed forms for +'index'+. @@ -3253,12 +3339,12 @@ This is the default. +*-glob*+:: - +'pattern'+ is a glob-style pattern which is matched against each list element using the same - rules as the string match command. + +'pattern'+ is a glob-style pattern which is matched against each list element using + <<_string_matching,STRING MATCHING>> rules. +*-regexp*+:: +'pattern'+ is treated as a regular expression and matched against each list element using - the rules described by `regexp`. + <<_regular_expressions,REGULAR EXPRESSIONS>> rules. +*-command* 'cmdname'+:: +'cmdname'+ is a command which is used to match the pattern against each element of the @@ -3291,35 +3377,80 @@ +*-nocase*+:: Causes comparisons to be handled in a case-insensitive manner. ++*-index* 'indexList'+:: + This option is designed for use when searching within nested lists. The + 'indexList' gives a path of indices (much as might be used with + the lindex or lset commands) within each element to allow the location + of the term being matched against. + ++*-stride* 'strideLength'+:: + If this option is specified, the list is treated as consisting of + groups of 'strideLength' elements and the groups are searched by + either their first element or, if the +-index+ option is used, + by the element within each group given by the first index passed to + +-index+ (which is then ignored by +-index+). The resulting + index always points to the first element in a group. + :: + The list length must be an integer multiple of 'strideLength', which + in turn must be at least 1. A 'strideLength' of 1 is the default and + indicates no grouping. + lsort ~~~~~ -+*lsort* ?*-index* 'listindex'? ?*-nocase|-integer|-real|-command* 'cmdname'? ?*-unique*? ?*-decreasing*|*-increasing*? 'list'+ ++*lsort* '?options? list'+ Sort the elements of +'list'+, returning a new list in sorted order. By default, ASCII (or UTF-8) sorting is used, with the result in increasing order. -If +-nocase+ is specified, comparisons are case-insensitive. - -If +-integer+ is specified, numeric sorting is used. +Note that only one sort type may be selected with +-integer+, +-real+, +-nocase+ or +-command+ +with last option being used. -If +-real+ is specified, floating point number sorting is used. ++*-integer*+:: + Sort using numeric (integer) comparison. -If +-command 'cmdname'+ is specified, +'cmdname'+ is treated as a command -name. For each comparison, +'cmdname $value1 $value2+' is called which -should compare the values and return an integer less than, equal -to, or greater than zero if the +'$value1'+ is to be considered less -than, equal to, or greater than +'$value2'+, respectively. ++*-real*+:: + Sort using floating point comparison. -If +-decreasing+ is specified, the resulting list is in the opposite -order to what it would be otherwise. +-increasing+ is the default. - -If +-unique+ is specified, then only the last set of duplicate elements found in the list will be retained. -Note that duplicates are determined relative to the comparison used in the sort. Thus if +-index 0+ is used, -+{1 a}+ and +{1 b}+ would be considered duplicates and only the second element, +{1 b}+, would be retained. ++*-nocase*+:: + Sort using using string comparison without regard for case. -If +-index 'listindex'+ is specified, each element of the list is treated as a list and -the given index is extracted from the list for comparison. The list index may -be any valid list index, such as +1+, +end+ or +end-2+. ++*-command* 'cmdname'+:: + +'cmdname'+ is treated as a command name. For each comparison, + +'cmdname $value1 $value2+' is called which + should compare the values and return an integer less than, equal + to, or greater than zero if the +'$value1'+ is to be considered less + than, equal to, or greater than +'$value2'+, respectively. + ++*-increasing*+:: + The resulting list is in ascending order, from smallest/lowest to largest/highest. + This is the default and does not need to be specified. + ++*-decreasing*+:: + The resulting list is in the opposite order to what it would be otherwise. + ++*-unique*+:: + Only the last set of duplicate elements found in the list will + be retained. Note that duplicates are determined relative to the + comparison used in the sort. Thus if +-index 0+ is used, +{1 a}+ and + +{1 b}+ would be considered duplicates and only the second element, + +{1 b}+, would be retained. + ++*-index* 'indexList'+:: + This option is designed for use when sorting nested lists. The + 'indexList' gives a path of indices (much as might be used with + the lindex or lset commands) within each element to specify the + value to be used for comparison. + ++*-stride* 'strideLength'+:: + If this option is specified, the list is treated as consisting of + groups of 'strideLength' elements and the groups are sorted by + either their first element or, if the +-index+ option is used, + by the element within each group given by the first index passed to + +-index+ (which is then ignored by +-index+). The resulting list + is once again a flat list. + :: + The list length must be an integer multiple of 'strideLength', which + in turn must be at least 2. defer ~~~~~ @@ -3378,6 +3509,41 @@ +'access'+ defaults to 'r'. +Additionally, if POSIX mode is supported by the underlying system, +then access may insted of consistent of a list of any of the following +flags, all of which have the standard POSIX meanings. In this case, +the first flag *must* be one of RDONLY, WRONLY or RDWR. + ++RDONLY+:: + Open the file for reading only. + ++WRONLY+:: + Open the file for writing only. + ++RDWR+:: + Open the file for both reading and writing. + ++APPEND+:: + Set the file pointer to the end of the file prior to each write. + ++BINARY+:: + Ignored. + ++CREAT+:: + Create the file if it does not already exist (without this flag + it is an error for the file not to exist). + ++EXCL+:: + If CREAT is also specified, an error is returned if the file + already exists. + ++NOCTTY+:: + If the file is a terminal device, this flag prevents the file + from becoming the controlling terminal of the process. + ++TRUNC+:: + If the file exists it is truncated to zero length. + If a file is opened for both reading and writing, then `seek` must be invoked between a read and a write, or vice versa. @@ -3403,12 +3569,13 @@ +*package provide* 'name ?version?'+ Indicates that the current script provides the package named +'name'+. -If no version is specified, '1.0' is used. +*Note*: The supplied version is ignored. All packages are registered as version 1.0 +(it is simply accepted for compatibility purposes). -Any script which provides a package may include this statement +Any script that provides a package may include this statement as the first statement, although it is not required. -+*package require* 'name ?version?'*+ ++*package require* 'name ?version?'+ Searches for the package with the given +'name'+ by examining each path in '$::auto_path' and trying to load '$path/$name.so' as a dynamic extension, @@ -3423,6 +3590,10 @@ If `load` or `source` fails, `package require` will fail immediately. No further attempt will be made to locate the file. ++*package names*+ + +Returns a list of all known/loaded packages, including internal packages. + pid ~~~ +*pid*+ @@ -3448,7 +3619,7 @@ If specified, +'statics'+, declares static variables which are bound to the procedure. -See <<_procedures,PROCEDURES> for detailed information about Tcl procedures. +See <<_procedures,PROCEDURES>> for detailed information about Tcl procedures. The `proc` command returns +'name'+ (which is useful with `local`). @@ -3528,6 +3699,8 @@ 7 5 ---- +Integer parameters may be any integer expression. + read ~~~~ +*read* ?*-nonewline*? 'fileId'+ @@ -3538,6 +3711,10 @@ +'fileId' *read* 'numBytes'+ ++*read* ?*-pending*? 'fileId'+ + ++'fileId' *read* ?*-pending*?+ + In the first form, all of the remaining bytes are read from the file given by +'fileId'+; they are returned as the result of the command. If the +-nonewline+ switch is specified then the last @@ -3548,6 +3725,21 @@ +'numBytes'+ bytes left in the file; in this case, all the remaining bytes are returned. +The third form is currently only useful with SSL sockets. It reads at least 1 byte +and then any additional data that is buffered. This allows for use in an event handler. +e.g. + +---- + $sock readable { + set buf [$sock read -pending] + } +---- + +This is necessary because otherwise pending data may be buffered, but +the underlying socket will not be marked 'readable'. This featured is not +currently supported for regular sockets, and so these sockets must be +set to unbufferred (+$sock buffering false+) to work in an event loop. + +'fileId'+ must be +stdin+ or the return value from a previous call to `open`; it must refer to a file that was opened for reading. @@ -3592,9 +3784,9 @@ Use newline-sensitive matching. By default, newline is a completely ordinary character with no special meaning in either REs or strings. With this flag, +[^+ bracket expressions - and +.+ never match newline, an +^+ anchor matches the null + and +.+ never match newline, an +^+ anchor matches the empty string after any newline in the string in addition to its normal - function, and the +$+ anchor matches the null string before any + function, and the +$+ anchor matches the empty string before any newline in the string in addition to its normal function. +*-indices*+:: @@ -3684,9 +3876,9 @@ Use newline-sensitive matching. By default, newline is a completely ordinary character with no special meaning in either REs or strings. With this flag, +[^+ bracket expressions - and +.+ never match newline, an +^+ anchor matches the null + and +.+ never match newline, an +^+ anchor matches the empty string after any newline in the string in addition to its normal - function, and the +$+ anchor matches the null string before any + function, and the +$+ anchor matches the empty string before any newline in the string in addition to its normal function. +*-start* 'offset'+:: @@ -4123,31 +4315,10 @@ it will return the string +02c322c222c+. +*string match ?-nocase?* 'pattern string'+:: - See if +'pattern'+ matches +'string'+; return 1 if it does, 0 - if it doesn't. Matching is done in a fashion similar to that - used by the C-shell. For the two strings to match, their contents - must be identical except that the following special sequences - may appear in +'pattern'+: - - +*+;; - Matches any sequence of characters in +'string'+, - including a null string. - - +?+;; - Matches any single character in +'string'+. - - +['chars']+;; - Matches any character in the set given by +'chars'+. - If a sequence of the form +'x-y'+ appears in +'chars'+, - then any character between +'x'+ and +'y'+, inclusive, - will match. - - +{backslash}x+;; - Matches the single character +'x'+. This provides a way of - avoiding the special interpretation of the characters +{backslash}*?[]+ - in +'pattern'+. - :: - Performs a case-insensitive comparison if +-nocase+ is specified. + See if +'pattern'+ matches +'string'+ according to + <<_string_matching,STRING MATCHING>> rules + ; return 1 if it does, 0 + if it doesn't. The match is performed in a case-insensitive manner if +-nocase+ is specified. +*string range* 'string first last'+:: Returns a range of consecutive characters from +'string'+, starting @@ -4263,13 +4434,11 @@ +-glob+:: When matching string to the patterns, use glob-style - matching (i.e. the same as implemented by the string - match command). + <<_string_matching,STRING MATCHING>> rules. +-regexp+:: - When matching string to the patterns, use regular - expression matching (i.e. the same as implemented - by the regexp command). + When matching string to the patterns, use + <<_regular_expressions,REGULAR EXPRESSIONS>> rules. +-command 'commandname'+:: When matching string to the patterns, use the given command, which @@ -4648,6 +4817,28 @@ The `while` command always returns an empty string. +xtrace +~~~~~~ ++*xtrace* 'command'+ + +Install an execution trace callback command. This is useful for implementing a debugger +or tracing tool. On each command invocation, the given command is invoked as: + +---- + command proc|cmd filename line result command arglist +---- + ++'proc'+ or +'cmd'+ indicates whether a command or a proc body is being executed. ++'filename'+ and +'line'+ indicate the location where the command was invoked. ++'result'+ is the current interpreter result (from the previous command). ++'command'+ and +'arglist'+ indicate the command being executed. + +While the callback is executing, any further execution traces are temporarily disabled. +If the callback returns +JIM_OK+ or +JIM_RETURN+, the execution trace is reinstalled. Otherwise +the execution trace is removed. + +If +*xtrace*+ is called with an empty argument (""), any existing callback is removed. + OPTIONAL-EXTENSIONS ------------------- @@ -4740,8 +4931,8 @@ +$handle *puts ?-nonewline?* 'str'+:: Write the string, with newline unless -nonewline -+$handle *read ?-nonewline?* '?len?'+:: - Read and return bytes from the stream. To eof if no len. ++$handle *read ?-nonewline|-pending*|len?'+:: + Read and return bytes from the stream. To eof if no len. See `read`. +$handle *recvfrom* 'maxlen ?addrvar?'+:: Receives a message from the handle via recvfrom(2) and returns it. @@ -4778,7 +4969,7 @@ +$handle *tty* ?settings?+:: If no arguments are given, returns a dictionary containing the tty settings for the stream. If arguments are given, they must either be a dictionary, or +setting value \...+ - Abbrevations are supported for both settings and values, so the following is acceptable: + Abbreviations are supported for both settings and values, so the following is acceptable: +$f tty parity e input c out raw+. Only available on platforms that support 'termios(3)'. Supported settings are: @@ -4814,8 +5005,12 @@ +*vtime* 'time'+;; Timeout for noncanonical read (units of 0.1 seconds) -+$handle *ssl* ?*-server* 'cert priv'?+:: ++$handle *ssl* ?*-server* 'cert ?key?'|*-sni* 'servername'?+:: Upgrades the stream to a SSL/TLS session and returns the handle. + If +-server+ is specified, either both the certificate and private key files + must be specified, or a single file must be specified containing both. + If +-server+ is not specified, the connection is a client connection. In this case + +-sni+ may be specified if required to set the Server Name Indication. +$handle *unlock*+:: Release a POSIX lock previously acquired by `aio lock`. @@ -4945,6 +5140,10 @@ A socketpair (see socketpair(2)). Like `pipe`, this command returns a list of two channels: {s1 s2}. These channels are both readable and writable. ++*socket pty*+:: + A pseudo-tty pair (see openpty(3)). Like `pipe`, this command returns + a list of two channels: {master slave}. These channels are both readable and writable. + This command creates a socket connected (client) or bound (server) to the given address. @@ -5061,7 +5260,7 @@ +*inflate* 'data' '?bufferSize?'+:: Decompresses a raw, Deflate-compressed stream. When the uncompressed data size is known and specified, memory - allocation is more efficient. Otherwise, decomperssion is chunked and therefore slower. + allocation is more efficient. Otherwise, decompression is chunked and therefore slower. +*gzip* 'string' '?-level level?'+:: Compresses a buffer and adds a gzip header. @@ -5220,6 +5419,9 @@ +*history add* 'line'+:: Adds the given line to the history buffer. ++*history keep* '?count?'+:: + Set or return the maximum history size. Defaults to 100. + +*history save* 'filename'+:: Saves the current history buffer to the given file. @@ -5270,12 +5472,12 @@ +*interp*+:: Creates and returns a new interpreter object (command). - The created interpeter contains any built-in commands along with static extensions, + The created interpreter contains any built-in commands along with static extensions, but does not include any dynamically loaded commands (package require, load). These must be reloaded in the child interpreter if required. +*$interp delete*+:: - Deletes the interpeter object. + Deletes the interpreter object. +*$interp eval* 'script' ...+:: Evaluates a script in the context for the child interpreter, in the same way as 'eval'. diff -Nru jimtcl-0.79+dfsg0/jim-win32.c jimtcl-0.81+dfsg0/jim-win32.c --- jimtcl-0.79+dfsg0/jim-win32.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-win32.c 2021-11-27 23:06:54.000000000 +0000 @@ -506,8 +506,7 @@ int Jim_win32Init(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "win32", "1.0", JIM_ERRMSG)) - return JIM_ERR; + Jim_PackageProvideCheck(interp, "win32"); #define CMD(name) \ Jim_CreateCommand(interp, "win32." #name , Win32_ ## name , NULL, NULL) diff -Nru jimtcl-0.79+dfsg0/jim-zlib.c jimtcl-0.81+dfsg0/jim-zlib.c --- jimtcl-0.79+dfsg0/jim-zlib.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jim-zlib.c 2021-11-27 23:06:54.000000000 +0000 @@ -309,10 +309,7 @@ int Jim_zlibInit(Jim_Interp *interp) { - if (Jim_PackageProvide(interp, "zlib", "1.0", JIM_ERRMSG)) { - return JIM_ERR; - } - + Jim_PackageProvideCheck(interp, "zlib"); Jim_CreateCommand(interp, "zlib", JimZlibCmd, 0, 0); return JIM_OK; diff -Nru jimtcl-0.79+dfsg0/jsonencode.tcl jimtcl-0.81+dfsg0/jsonencode.tcl --- jimtcl-0.79+dfsg0/jsonencode.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/jsonencode.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -21,80 +21,73 @@ # Top level JSON encoder which encodes the given # value based on the schema proc json::encode {value {schema str}} { - json::encode.[lindex $schema 0] $value [lrange $schema 1 end] + json::subencode [lindex $schema 0] $value [lrange $schema 1 end] } -# Encode a string -proc json::encode.str {value {dummy {}}} { - # Strictly we should be converting \x00 through \x1F to unicode escapes - # And anything outside the BMP to a UTF-16 surrogate pair - return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\" -} - -# If no type is given, also encode as a string -proc json::encode. {args} { - tailcall json::encode.str {*}$args -} - -# Encode a number -proc json::encode.num {value {dummy {}}} { - if {$value in {Inf -Inf}} { - append value inity - } - return $value -} - -# Encode a boolean -proc json::encode.bool {value {dummy {}}} { - if {$value} { - return true - } - return false -} - -# Encode an object (dictionary) -proc json::encode.obj {obj {schema {}}} { - set result "\{" - set sep " " - foreach k [lsort [dict keys $obj]] { - if {[dict exists $schema $k]} { - set type [dict get $schema $k] - } elseif {[dict exists $schema *]} { - set type [dict get $schema *] - } else { - set type str +# encode the value according to to the given type +proc json::subencode {type value {schema {}}} { + switch -exact -- $type { + str - "" { + # Strictly we should be converting \x00 through \x1F to unicode escapes + # And anything outside the BMP to a UTF-16 surrogate pair + return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\" + } + num { + if {$value in {Inf -Inf}} { + append value inity + } + return $value + } + bool { + if {$value} { + return true + } + return false + } + obj { + set result "\{" + set sep " " + foreach k [lsort [dict keys $value]] { + if {[dict exists $schema $k]} { + set subtype [dict get $schema $k] + } elseif {[dict exists $schema *]} { + set subtype [dict get $schema *] + } else { + set subtype str + } + append result $sep\"$k\": + + append result [json::subencode [lindex $subtype 0] [dict get $value $k] [lrange $subtype 1 end]] + set sep ", " + } + append result " \}" + return $result + } + list { + set result "\[" + set sep " " + foreach l $value { + append result $sep + append result [json::subencode [lindex $schema 0] $l [lrange $schema 1 end]] + set sep ", " + } + append result " \]" + return $result + } + mixed { + set result "\[" + set sep " " + foreach l $value subtype $schema { + append result $sep + append result [json::subencode [lindex $subtype 0] $l [lrange $subtype 1 end]] + set sep ", " + } + append result " \]" + } + default { + error "bad type $type" } - append result $sep\"$k\": - - append result [json::encode.[lindex $type 0] [dict get $obj $k] [lrange $type 1 end]] - set sep ", " - } - append result " \}" -} - -# Encode an array (list) -proc json::encode.list {list {type str}} { - set result "\[" - set sep " " - foreach l $list { - append result $sep - append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]] - set sep ", " - } - append result " \]" -} - -# Encode a mixed-type array (list) -# Must be as many types as there are elements of the list -proc json::encode.mixed {list types} { - set result "\[" - set sep " " - foreach l $list type $types { - append result $sep - append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]] - set sep ", " } - append result " \]" } # vim: se ts=4: diff -Nru jimtcl-0.79+dfsg0/make-c-ext.tcl jimtcl-0.81+dfsg0/make-c-ext.tcl --- jimtcl-0.79+dfsg0/make-c-ext.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/make-c-ext.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -18,8 +18,8 @@ while {[gets $f buf] >= 0} { # Remove comment lines regsub {^[ \t]*#.*$} $buf "" buf - # Escape quotes and backlashes - set buf [string map [list \\ \\\\ \" \\"] $buf] + # Escape quotes and backlashes and remove carriage returns + set buf [string map [list \\ \\\\ \" \\" \r ""] $buf] lappend sourcelines \"$buf\\n\" } close $f diff -Nru jimtcl-0.79+dfsg0/Makefile.in jimtcl-0.81+dfsg0/Makefile.in --- jimtcl-0.79+dfsg0/Makefile.in 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/Makefile.in 2021-11-27 23:06:54.000000000 +0000 @@ -19,6 +19,9 @@ RANLIB = @RANLIB@ AR = @AR@ STRIP = @STRIP@ +@if COVERAGE +export CCACHE_DISABLE := 1 +@endif # Configuration @@ -41,6 +44,7 @@ exec_prefix ?= @exec_prefix@ prefix ?= @prefix@ docdir = @docdir@ +srcdir := @srcdir@ CC += -Wall $(OPTIM) -I. CXX += -Wall $(OPTIM) -I. @@ -113,6 +117,7 @@ install-exec: all $(INSTALL_DATA_DIR) $(DESTDIR)@bindir@ $(INSTALL_PROGRAM) $(JIMSH) $(DESTDIR)@bindir@ + $(INSTALL_PROGRAM) @srcdir@/jimdb $(DESTDIR)@bindir@ uninstall: rm -f $(DESTDIR)@bindir@/$(JIMSH) @@ -127,7 +132,7 @@ @endif test check: $(JIMSH) - cd @srcdir@/tests; $(DEF_LD_PATH) $(MAKE) jimsh=@builddir@/jimsh TOPSRCDIR=.. + $(DEF_LD_PATH) $(MAKE) -C tests jimsh="@builddir@/jimsh" $(OBJS) jimsh.o initjimsh.o: Makefile $(wildcard *.h) @@ -177,17 +182,38 @@ Tcl.html: jim_tcl.txt @srcdir@/make-index @if HAVE_ASCIIDOC - @tclsh@ @srcdir@/make-index $> $^ | @ASCIIDOC@ -d manpage - | @SED@ -e '/^/d' >$@ + @tclsh@ @srcdir@/make-index $> $^ | @ASCIIDOC@ --attribute footer-style=none -d manpage - >$@ @else @echo "asciidoc is not available"; false @endif +coverage: +@if COVERAGE +@if COVERAGE_TOOL eq "lcov" + @LCOV@ -c --rc genhtml_branch_coverage=1 -d . -o lcov.txt + @GENHTML@ --rc genhtml_branch_coverage=1 -o coverage_html lcov.txt > genhtml_output.txt + @LCOV@ --summary lcov.txt +@endif +@if COVERAGE_TOOL eq "gcovr" + @GCOVR@ -s -e 'conftest*' --html --html-details --output coverage.html +@endif +@if COVERAGE_TOOL eq "gcov" + gcov @srcdir@/*.c +@endif +@else + @echo "Use ./configure --coverage to enable code coverage" +@endif + clean: rm -f *.o *.so *.dll *.exe lib*.a $(JIMSH) $(LIBJIM) Tcl.html _*.c +@if COVERAGE + rm -f *.gcno *.gcov *.gcda */*.gcno */*.gcda */*.gcov coverage*.html + rm -rf coverage_html lcov.txt genhtml_output.txt +@endif distclean: clean - rm -f jimautoconf.h jim-config.h Makefile config.log @srcdir@/autosetup/jimsh0@EXEEXT@ build-jim-ext - rm -f jimtcl.pc tests/Makefile + rm -f jimautoconf.h jim-config.h Makefile config.log jimsh0@EXEEXT@ build-jim-ext + rm -f jimtcl.pc tests/Makefile examples.api/Makefile ship: Tcl.html cp $< Tcl_shipped.html diff -Nru jimtcl-0.79+dfsg0/oo.tcl jimtcl-0.81+dfsg0/oo.tcl --- jimtcl-0.79+dfsg0/oo.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/oo.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -22,7 +22,6 @@ # Merge in the baseclass vars with lower precedence set classvars [dict merge $baseclassvars $classvars] - set vars [lsort [dict keys $classvars]] # This is the class dispatcher for $classname # It simply dispatches 'classname cmd' to a procedure named {classname cmd} @@ -40,8 +39,7 @@ # This is the object dispatcher for $classname. # Store the classname in both the ref value and tag, for debugging - # ref tag (for debugging) - set obj [ref $classname $classname "$classname finalize"] + set obj ::[ref $classname $classname "$classname finalize"] proc $obj {method args} {classname instvars} { if {![exists -command "$classname $method"]} { if {![exists -command "$classname unknown"]} { @@ -69,12 +67,12 @@ # Note that we can't use 'dict with' here because # the dict isn't updated until the body completes. foreach __ [$self vars] {upvar 1 instvars($__) $__} - unset __ + unset -nocomplain __ eval $__body } } # Other simple class procs - proc "$classname vars" {} vars { return $vars } + proc "$classname vars" {} classvars { lsort [dict keys $classvars] } proc "$classname classvars" {} classvars { return $classvars } proc "$classname classname" {} classname { return $classname } proc "$classname methods" {} classname { @@ -85,9 +83,10 @@ # Pre-defined some instance methods $classname method destroy {} { rename $self "" } $classname method get {var} { set $var } - $classname method eval {{locals {}} __code} { - foreach var $locals { upvar 2 $var $var } - eval $__code + $classname method eval {{__locals {}} __body} { + foreach __ $__locals { upvar 2 $__ $__ } + unset -nocomplain __ + eval $__body } return $classname } @@ -95,6 +94,7 @@ # From within a method, invokes the given method on the base class. # Note that this will only call the last baseclass given proc super {method args} { - upvar self self - uplevel 2 [$self baseclass] $method {*}$args + # If we are called from "class method", we want to call "[$class baseclass] method" + set classname [lindex [info level -1] 0 0] + uplevel 2 [list [$classname baseclass] $method {*}$args] } diff -Nru jimtcl-0.79+dfsg0/parse-unidata.tcl jimtcl-0.81+dfsg0/parse-unidata.tcl --- jimtcl-0.79+dfsg0/parse-unidata.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/parse-unidata.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -33,6 +33,8 @@ set f [open $unicodefile] while {[gets $f buf] >= 0} { + # Remove any trailing whitespace, especially errant CR + set buf [string trim $buf] set title "" set lower "" set upper "" @@ -115,6 +117,8 @@ if {$do_width} { set f [open $widthfile] while {[gets $f buf] >= 0} { + # Remove any trailing whitespace, especially errant CR + set buf [string trim $buf] if {[regexp {^([0-9A-Fa-f.]+);W} $buf -> range]} { set range [string tolower $range] lassign [split $range .] lower - upper diff -Nru jimtcl-0.79+dfsg0/README jimtcl-0.81+dfsg0/README --- jimtcl-0.79+dfsg0/README 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/README 2021-11-27 23:06:54.000000000 +0000 @@ -190,7 +190,7 @@ "first Jim goal: to vent my need to hack on Tcl." And actually this is exactly why I started Jim, in the first days -of Jenuary 2005. After a month of hacking Jim was able to run +of January 2005. After a month of hacking Jim was able to run simple scripts, now, after two months it started to be clear to me that it was not just the next toy to throw away but something that may evolve into a real interpreter. In the same time diff -Nru jimtcl-0.79+dfsg0/README.metakit jimtcl-0.81+dfsg0/README.metakit --- jimtcl-0.79+dfsg0/README.metakit 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/README.metakit 2021-11-27 23:06:54.000000000 +0000 @@ -39,7 +39,7 @@ CREATING VIEWS -------------- *Views* in Metakit are what is called "tables" in conventional databases. A view -may several typed *properties*, or columns, and contains homogenous *rows*, or +may several typed *properties*, or columns, and contains homogeneous *rows*, or records. New properties may be added to a view as needed; however, new properties are not stored in the database file by default. The structure method specifies the stored properties of a view, creating a new view or restructuring an old one @@ -74,7 +74,7 @@ `subview` : This type is not usually specified directly; instead, a structure description of a nested view is given. `subview` properties store complete - views as their value, creating hierarchical data structures. When retreived + views as their value, creating hierarchical data structures. When retrieved from a view, a value of a subview property is a normal view handle. Without a `description` parameter, the `structure` method returns the current @@ -108,7 +108,7 @@ and may also be specified relative to the last row of the view using the `end[+-]integer` notation. -A dictionary containing all property name and value pairs can be retreived by +A dictionary containing all property name and value pairs can be retrieved by omitting the `propName` argument: cursor get $cur diff -Nru jimtcl-0.79+dfsg0/README.redis jimtcl-0.81+dfsg0/README.redis --- jimtcl-0.79+dfsg0/README.redis 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/README.redis 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,105 @@ +Jim redis extension documentation. + +Overview +~~~~~~~~ + +The redis extension is a very simple extension to provide fast +client access to redis (https://redis.io/) via the hiredis library +(which must be available when building). + +Usage +~~~~~ + +The redis extension exports an Object Based interface. In order +to open a connection, a stream sock must be open to the redis server. +e.g. + + set r [redis [socket stream localhost:6379]] + +Or to connect via the unix domain socket: + + set r [redis [socket unix /tmp/redis.sock]] + +The [redis] command returns a handle, that is a command name that +can be used to perform operations on the redis instance. A real example: + + . package require redis + 1.0 + . set r [redis [socket stream localhost:6379]] + ::redis.handle4 + . $r KEYS a* + abc + . $r SET def 3 + OK + . $r INCR def + 4 + . $r HMSET hash a 1 b 2 c 3 + OK + . $r HGETALL hash + a 1 b 2 c 3 + +Note that redis commands are shown here in uppercase, but they are accepted in +a case insensitive manner. + +The redis connection is very thin wrapper around the redis protocol. +It simply formats the command according the redis protocol and converts +the response into the appropriate Tcl format. + +Note that all values are binary strings, so keys and values in utf-8 +format will be stored and returned exactly. + +Return values +~~~~~~~~~~~~~ + +The response from redis contains a type, and these types are handled as follows: + +* integer - returns the integer result +* string - returns the string result +* array - returns a list of elements (where each element is a redis type) +* null - returns the empty string +* status - returns the status as a string +* error - returns an error with the message as the value + +The read subcommand +~~~~~~~~~~~~~~~~~~~ + +While most redis commands return an immediate response, SUBSRIBE and PSUBSCRIBE +return multiple results over time. These responses can be (synchronously) +read with the 'read' subcommand, typically in conjunction with readable. + +For example + + . $r SUBSCRIBE chan + subscribe chan 1 + . $r read + message chan PONG + +If no message is received, the read command will wait forever. + +The message is returned as: message + +The readable subcommand +~~~~~~~~~~~~~~~~~~~~~~~ + +Like normal aio sockets, the readable subcommand is supported to invoke +the given script when the underlying socket is readable. + + $r SUBSCRIBE channel + $r readable { + puts [$r read] + } + # wait forever, reading messages from the channel + vwait forever + +To remove the callback, invoke with no arguments (this is different from aio readable). + + # Remove the callback + $r readable + +The close subcommand +~~~~~~~~~~~~~~~~~~~~ + +The 'close' command is supported to close the connection. +This command is equivalent to deleting the command with: + + rename $r "" diff -Nru jimtcl-0.79+dfsg0/README.utf-8 jimtcl-0.81+dfsg0/README.utf-8 --- jimtcl-0.79+dfsg0/README.utf-8 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/README.utf-8 2021-11-27 23:06:54.000000000 +0000 @@ -32,7 +32,7 @@ Unicode into bytes. Thus the Unicode codepoint U+00B5 is encoded in UTF-8 with the byte sequence: 0xc2, 0xb5. This is different from ASCII where the same name is used interchangeably between a character value -and and its encoding. +and its encoding. Unicode Escapes --------------- diff -Nru jimtcl-0.79+dfsg0/regtest.tcl jimtcl-0.81+dfsg0/regtest.tcl --- jimtcl-0.79+dfsg0/regtest.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/regtest.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -350,6 +350,17 @@ catch {expr {2 && "abc$"}} puts "TEST 51 PASSED" +# REGTEST 52 +# lsearch -command with too few args +catch {lsearch -all -command abc def} +puts "TEST 52 PASSED" + +# REGTEST 53 +# string last with invalid index +catch {string last foo bar -1} +puts "TEST 53 PASSED" + + # TAKE THE FOLLOWING puts AS LAST LINE puts "--- ALL TESTS PASSED ---" diff -Nru jimtcl-0.79+dfsg0/sqlite3/jim-sqlite3.c jimtcl-0.81+dfsg0/sqlite3/jim-sqlite3.c --- jimtcl-0.79+dfsg0/sqlite3/jim-sqlite3.c 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/sqlite3/jim-sqlite3.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,2830 +0,0 @@ -/* Jim Tcl version of the sqlite3 Tcl binding. - * From sqlite3 3.6.22 - * - * This version is (c) Steve Bennett - * Copyright of the original version is below. - */ - -/* -** 2001 September 15 -** -** The author disclaims copyright to this source code. In place of -** a legal notice, here is a blessing: -** -** May you do good and not evil. -** May you find forgiveness for yourself and forgive others. -** May you share freely, never taking more than you give. -** -************************************************************************* -** A TCL Interface to SQLite. Append this file to sqlite3.c and -** compile the whole thing to build a TCL-enabled version of SQLite. -** -** Compile-time options: -** -** -D SQLITE_TEST When used in conjuction with -DTCLSH=1, add -** hundreds of new commands used for testing -** SQLite. This option implies -DSQLITE_TCLMD5. -*/ -#include -#include -#include -#include - -/* -** Some additional include files are needed if this file is not -** appended to the amalgamation. -*/ -#ifndef SQLITE_AMALGAMATION -# include "sqlite3.h" -# include -# include -# include - typedef unsigned char u8; -#endif -#include - -#define NUM_PREPARED_STMTS 10 -#define MAX_PREPARED_STMTS 100 - -/* -** If Jim Tcl uses UTF-8 and SQLite is configured to use iso8859, then we -#ifdef JIM_UTF8 -#define SQLITE_UTF8 -#endif - -** have to do a translation when going between the two. Set the -** UTF_TRANSLATION_NEEDED macro to indicate that we need to do -** this translation. -*/ -#if defined(JIM_UTF8) && !defined(SQLITE_UTF8) -# define UTF_TRANSLATION_NEEDED 1 -# warning Jim Tcl can not translate encoding from iso8859 to utf-8 -#endif - -/* -** New SQL functions can be created as TCL scripts. Each such function -** is described by an instance of the following structure. -*/ -typedef struct SqlFunc SqlFunc; -struct SqlFunc { - Jim_Interp *interp; /* The TCL interpret to execute the function */ - Jim_Obj *pScript; /* The Jim_Obj representation of the script */ - int useEvalObjv; /* True if it is safe to use Jim_EvalObjv */ - char *zName; /* Name of this function */ - SqlFunc *pNext; /* Next function on the list of them all */ -}; - -/* -** New collation sequences function can be created as TCL scripts. Each such -** function is described by an instance of the following structure. -*/ -typedef struct SqlCollate SqlCollate; -struct SqlCollate { - Jim_Interp *interp; /* The TCL interpret to execute the function */ - char *zScript; /* The script to be run */ - SqlCollate *pNext; /* Next function on the list of them all */ -}; - -/* -** Prepared statements are cached for faster execution. Each prepared -** statement is described by an instance of the following structure. -*/ -typedef struct SqlPreparedStmt SqlPreparedStmt; -struct SqlPreparedStmt { - SqlPreparedStmt *pNext; /* Next in linked list */ - SqlPreparedStmt *pPrev; /* Previous on the list */ - sqlite3_stmt *pStmt; /* The prepared statement */ - int nSql; /* chars in zSql[] */ - const char *zSql; /* Text of the SQL statement */ - int nParm; /* Size of apParm array */ - Jim_Obj **apParm; /* Array of referenced object pointers */ -}; - -typedef struct IncrblobChannel IncrblobChannel; - -/* -** There is one instance of this structure for each SQLite database -** that has been opened by the SQLite TCL interface. -*/ -typedef struct SqliteDb SqliteDb; -struct SqliteDb { - sqlite3 *db; /* The "real" database structure. MUST BE FIRST */ - Jim_Interp *interp; /* The interpreter used for this database */ - char *zBusy; /* The busy callback routine */ - char *zCommit; /* The commit hook callback routine */ - char *zTrace; /* The trace callback routine */ - char *zProfile; /* The profile callback routine */ - char *zProgress; /* The progress callback routine */ - char *zAuth; /* The authorization callback routine */ - int disableAuth; /* Disable the authorizer if it exists */ - char *zNull; /* Text to substitute for an SQL NULL value */ - SqlFunc *pFunc; /* List of SQL functions */ - Jim_Obj *pUpdateHook; /* Update hook script (if any) */ - Jim_Obj *pRollbackHook; /* Rollback hook script (if any) */ - Jim_Obj *pUnlockNotify; /* Unlock notify script (if any) */ - SqlCollate *pCollate; /* List of SQL collation functions */ - int rc; /* Return code of most recent sqlite3_exec() */ - Jim_Obj *pCollateNeeded; /* Collation needed script */ - SqlPreparedStmt *stmtList; /* List of prepared statements*/ - SqlPreparedStmt *stmtLast; /* Last statement in the list */ - int maxStmt; /* The next maximum number of stmtList */ - int nStmt; /* Number of statements in stmtList */ - IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */ - int nStep, nSort; /* Statistics for most recent operation */ - int nTransaction; /* Number of nested [transaction] methods */ -}; - -struct IncrblobChannel { - sqlite3_blob *pBlob; /* sqlite3 blob handle */ - SqliteDb *pDb; /* Associated database connection */ - int iSeek; /* Current seek offset */ - Jim_Obj *channel; /* Channel identifier */ - IncrblobChannel *pNext; /* Linked list of all open incrblob channels */ - IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */ -}; - -/* -** Compute a string length that is limited to what can be stored in -** lower 30 bits of a 32-bit signed integer. -*/ -static int strlen30(const char *z){ - const char *z2 = z; - while( *z2 ){ z2++; } - return 0x3fffffff & (int)(z2 - z); -} - - -#ifndef SQLITE_OMIT_INCRBLOB -/* -** Close all incrblob channels opened using database connection pDb. -** This is called when shutting down the database connection. -*/ -static void closeIncrblobChannels(SqliteDb *pDb){ - IncrblobChannel *p; - IncrblobChannel *pNext; - - for(p=pDb->pIncrblob; p; p=pNext){ - pNext = p->pNext; - - /* Note: Calling unregister here call Jim_Close on the incrblob channel, - ** which deletes the IncrblobChannel structure at *p. So do not - ** call Jim_Free() here. - */ - Jim_UnregisterChannel(pDb->interp, p->channel); - } -} - -/* -** Close an incremental blob channel. -*/ -static int incrblobClose(ClientData instanceData, Jim_Interp *interp){ - IncrblobChannel *p = (IncrblobChannel *)instanceData; - int rc = sqlite3_blob_close(p->pBlob); - sqlite3 *db = p->pDb->db; - - /* Remove the channel from the SqliteDb.pIncrblob list. */ - if( p->pNext ){ - p->pNext->pPrev = p->pPrev; - } - if( p->pPrev ){ - p->pPrev->pNext = p->pNext; - } - if( p->pDb->pIncrblob==p ){ - p->pDb->pIncrblob = p->pNext; - } - - /* Free the IncrblobChannel structure */ - Jim_Free((char *)p); - - if( rc!=SQLITE_OK ){ - Jim_SetResult(interp, (char *)sqlite3_errmsg(db), JIM_VOLATILE); - return JIM_ERR; - } - return JIM_OK; -} - -/* -** Read data from an incremental blob channel. -*/ -static int incrblobInput( - ClientData instanceData, - char *buf, - int bufSize, - int *errorCodePtr -){ - IncrblobChannel *p = (IncrblobChannel *)instanceData; - int nRead = bufSize; /* Number of bytes to read */ - int nBlob; /* Total size of the blob */ - int rc; /* sqlite error code */ - - nBlob = sqlite3_blob_bytes(p->pBlob); - if( (p->iSeek+nRead)>nBlob ){ - nRead = nBlob-p->iSeek; - } - if( nRead<=0 ){ - return 0; - } - - rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek); - if( rc!=SQLITE_OK ){ - *errorCodePtr = rc; - return -1; - } - - p->iSeek += nRead; - return nRead; -} - -/* -** Write data to an incremental blob channel. -*/ -static int incrblobOutput( - ClientData instanceData, - CONST char *buf, - int toWrite, - int *errorCodePtr -){ - IncrblobChannel *p = (IncrblobChannel *)instanceData; - int nWrite = toWrite; /* Number of bytes to write */ - int nBlob; /* Total size of the blob */ - int rc; /* sqlite error code */ - - nBlob = sqlite3_blob_bytes(p->pBlob); - if( (p->iSeek+nWrite)>nBlob ){ - *errorCodePtr = EINVAL; - return -1; - } - if( nWrite<=0 ){ - return 0; - } - - rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek); - if( rc!=SQLITE_OK ){ - *errorCodePtr = EIO; - return -1; - } - - p->iSeek += nWrite; - return nWrite; -} - -/* -** Seek an incremental blob channel. -*/ -static int incrblobSeek( - ClientData instanceData, - long offset, - int seekMode, - int *errorCodePtr -){ - IncrblobChannel *p = (IncrblobChannel *)instanceData; - - switch( seekMode ){ - case SEEK_SET: - p->iSeek = offset; - break; - case SEEK_CUR: - p->iSeek += offset; - break; - case SEEK_END: - p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset; - break; - - default: assert(!"Bad seekMode"); - } - - return p->iSeek; -} - - -static void incrblobWatch(ClientData instanceData, int mode){ - /* NO-OP */ -} -static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){ - return JIM_ERR; -} - -static Jim_ChannelType IncrblobChannelType = { - "incrblob", /* typeName */ - JIM_CHANNEL_VERSION_2, /* version */ - incrblobClose, /* closeProc */ - incrblobInput, /* inputProc */ - incrblobOutput, /* outputProc */ - incrblobSeek, /* seekProc */ - 0, /* setOptionProc */ - 0, /* getOptionProc */ - incrblobWatch, /* watchProc (this is a no-op) */ - incrblobHandle, /* getHandleProc (always returns error) */ - 0, /* close2Proc */ - 0, /* blockModeProc */ - 0, /* flushProc */ - 0, /* handlerProc */ - 0, /* wideSeekProc */ -}; - -/* -** Create a new incrblob channel. -*/ -static int createIncrblobChannel( - Jim_Interp *interp, - SqliteDb *pDb, - const char *zDb, - const char *zTable, - const char *zColumn, - sqlite_int64 iRow, - int isReadonly -){ - IncrblobChannel *p; - sqlite3 *db = pDb->db; - sqlite3_blob *pBlob; - int rc; - int flags = JIM_READABLE|(isReadonly ? 0 : JIM_WRITABLE); - - /* This variable is used to name the channels: "incrblob_[incr count]" */ - static int count = 0; - char zChannel[64]; - - rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob); - if( rc!=SQLITE_OK ){ - Jim_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), JIM_VOLATILE); - return JIM_ERR; - } - - p = (IncrblobChannel *)Jim_Alloc(sizeof(IncrblobChannel)); - p->iSeek = 0; - p->pBlob = pBlob; - - sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count); - p->channel = Jim_CreateChannel(&IncrblobChannelType, zChannel, p, flags); - Jim_RegisterChannel(interp, p->channel); - - /* Link the new channel into the SqliteDb.pIncrblob list. */ - p->pNext = pDb->pIncrblob; - p->pPrev = 0; - if( p->pNext ){ - p->pNext->pPrev = p; - } - pDb->pIncrblob = p; - p->pDb = pDb; - - Jim_SetResult(interp, (char *)Jim_GetChannelName(p->channel), JIM_VOLATILE); - return JIM_OK; -} -#else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */ - #define closeIncrblobChannels(pDb) -#endif - -/* -** Look at the script prefix in pCmd. We will be executing this script -** after first appending one or more arguments. This routine analyzes -** the script to see if it is safe to use Jim_EvalObjv() on the script -** rather than the more general Jim_EvalEx(). Jim_EvalObjv() is much -** faster. -** -** Scripts that are safe to use with Jim_EvalObjv() consists of a -** command name followed by zero or more arguments with no [...] or $ -** or {...} or ; to be seen anywhere. Most callback scripts consist -** of just a single procedure name and they meet this requirement. -*/ -static int safeToUseEvalObjv(Jim_Interp *interp, Jim_Obj *pCmd){ - /* We could try to do something with Jim_Parse(). But we will instead - ** just do a search for forbidden characters. If any of the forbidden - ** characters appear in pCmd, we will report the string as unsafe. - */ - const char *z; - int n; - z = Jim_GetString(pCmd, &n); - while( n-- > 0 ){ - int c = *(z++); - if( c=='$' || c=='[' || c==';' ) return 0; - } - return 1; -} - -/* -** Find an SqlFunc structure with the given name. Or create a new -** one if an existing one cannot be found. Return a pointer to the -** structure. -*/ -static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){ - SqlFunc *p, *pNew; - int i; - pNew = (SqlFunc*)Jim_Alloc( sizeof(*pNew) + strlen30(zName) + 1 ); - pNew->zName = (char*)&pNew[1]; - for(i=0; zName[i]; i++){ pNew->zName[i] = tolower((unsigned)zName[i]); } - pNew->zName[i] = 0; - for(p=pDb->pFunc; p; p=p->pNext){ - if( strcmp(p->zName, pNew->zName)==0 ){ - Jim_Free((char*)pNew); - return p; - } - } - pNew->interp = pDb->interp; - pNew->pScript = 0; - pNew->pNext = pDb->pFunc; - pDb->pFunc = pNew; - return pNew; -} - -/* -** Finalize and free a list of prepared statements -*/ -static void flushStmtCache( SqliteDb *pDb ){ - SqlPreparedStmt *pPreStmt; - - while( pDb->stmtList ){ - sqlite3_finalize( pDb->stmtList->pStmt ); - pPreStmt = pDb->stmtList; - pDb->stmtList = pDb->stmtList->pNext; - Jim_Free( (char*)pPreStmt ); - } - pDb->nStmt = 0; - pDb->stmtLast = 0; -} - -/* -** TCL calls this procedure when an sqlite3 database command is -** deleted. -*/ -static void DbDeleteCmd(Jim_Interp *interp, void *db){ - SqliteDb *pDb = (SqliteDb*)db; - flushStmtCache(pDb); - closeIncrblobChannels(pDb); - sqlite3_close(pDb->db); - while( pDb->pFunc ){ - SqlFunc *pFunc = pDb->pFunc; - pDb->pFunc = pFunc->pNext; - Jim_DecrRefCount(interp, pFunc->pScript); - Jim_Free((char*)pFunc); - } - while( pDb->pCollate ){ - SqlCollate *pCollate = pDb->pCollate; - pDb->pCollate = pCollate->pNext; - Jim_Free((char*)pCollate); - } - if( pDb->zBusy ){ - Jim_Free(pDb->zBusy); - } - if( pDb->zTrace ){ - Jim_Free(pDb->zTrace); - } - if( pDb->zProfile ){ - Jim_Free(pDb->zProfile); - } - if( pDb->zAuth ){ - Jim_Free(pDb->zAuth); - } - if( pDb->zNull ){ - Jim_Free(pDb->zNull); - } - if( pDb->pUpdateHook ){ - Jim_DecrRefCount(interp, pDb->pUpdateHook); - } - if( pDb->pRollbackHook ){ - Jim_DecrRefCount(interp, pDb->pRollbackHook); - } - if( pDb->pCollateNeeded ){ - Jim_DecrRefCount(interp, pDb->pCollateNeeded); - } - Jim_Free((char*)pDb); -} - -/* -** This routine is called when a database file is locked while trying -** to execute SQL. -*/ -static int DbBusyHandler(void *cd, int nTries){ - SqliteDb *pDb = (SqliteDb*)cd; - int rc; - char zVal[30]; - Jim_Obj *objPtr; - - sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries); - - objPtr = Jim_NewStringObj(pDb->interp, pDb->zBusy, -1); - Jim_AppendStrings(pDb->interp, objPtr, " ", zVal, NULL); - rc = Jim_EvalObj(pDb->interp, objPtr); - if( rc!=JIM_OK || atoi(Jim_String(Jim_GetResult(pDb->interp))) ){ - return 0; - } - return 1; -} - -#ifndef SQLITE_OMIT_PROGRESS_CALLBACK -/* -** This routine is invoked as the 'progress callback' for the database. -*/ -static int DbProgressHandler(void *cd){ - SqliteDb *pDb = (SqliteDb*)cd; - int rc; - - assert( pDb->zProgress ); - rc = Jim_Eval(pDb->interp, pDb->zProgress); - if( rc!=JIM_OK || atoi(Jim_String(Jim_GetResult(pDb->interp))) ){ - return 1; - } - return 0; -} -#endif - -#ifndef SQLITE_OMIT_TRACE -/* -** This routine is called by the SQLite trace handler whenever a new -** block of SQL is executed. The TCL script in pDb->zTrace is executed. -*/ -static void DbTraceHandler(void *cd, const char *zSql){ - SqliteDb *pDb = (SqliteDb*)cd; - - Jim_Obj *str = Jim_NewStringObj(pDb->interp, pDb->zTrace, -1); - Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zSql, -1)); - Jim_Eval(pDb->interp, zSql); - Jim_SetEmptyResult(pDb->interp); -} -#endif - -#ifndef SQLITE_OMIT_TRACE -/* -** This routine is called by the SQLite profile handler after a statement -** SQL has executed. The TCL script in pDb->zProfile is evaluated. -*/ -static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){ - SqliteDb *pDb = (SqliteDb*)cd; - Jim_Obj *str; - char zTm[100]; - - sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm); - str = Jim_NewStringObj(pDb->interp, pDb->zProfile, -1); - Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zSql, -1)); - Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zTm, -1)); - Jim_EvalObj(pDb->interp, str); - Jim_SetEmptyResult(pDb->interp); -} -#endif - -/* -** This routine is called when a transaction is committed. The -** TCL script in pDb->zCommit is executed. If it returns non-zero or -** if it throws an exception, the transaction is rolled back instead -** of being committed. -*/ -static int DbCommitHandler(void *cd){ - SqliteDb *pDb = (SqliteDb*)cd; - int rc; - - rc = Jim_Eval(pDb->interp, pDb->zCommit); - if( rc!=JIM_OK || atoi(Jim_String(Jim_GetResult(pDb->interp))) ){ - return 1; - } - return 0; -} - -static void DbRollbackHandler(void *clientData){ - SqliteDb *pDb = (SqliteDb*)clientData; - assert(pDb->pRollbackHook); - Jim_EvalObjBackground(pDb->interp, pDb->pRollbackHook); -} - -#if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY) -static void setTestUnlockNotifyVars(Jim_Interp *interp, int iArg, int nArg){ - char zBuf[64]; - sprintf(zBuf, "%d", iArg); - Jim_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, JIM_GLOBAL_ONLY); - sprintf(zBuf, "%d", nArg); - Jim_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, JIM_GLOBAL_ONLY); -} -#else -# define setTestUnlockNotifyVars(x,y,z) -#endif - -#ifdef SQLITE_ENABLE_UNLOCK_NOTIFY -static void DbUnlockNotify(void **apArg, int nArg){ - int i; - for(i=0; iinterp, i, nArg); - assert( pDb->pUnlockNotify); - Jim_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags); - Jim_DecrRefCount(interp, pDb->pUnlockNotify); - pDb->pUnlockNotify = 0; - } -} -#endif - -static void DbUpdateHandler( - void *p, - int op, - const char *zDb, - const char *zTbl, - sqlite_int64 rowid -){ - SqliteDb *pDb = (SqliteDb *)p; - Jim_Obj *pCmd; - - assert( pDb->pUpdateHook ); - assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE ); - - pCmd = Jim_DuplicateObj(pDb->interp, pDb->pUpdateHook); - Jim_IncrRefCount(pCmd); - Jim_ListAppendElement(0, pCmd, Jim_NewStringObj(pDb->interp, - ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1)); - Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewStringObj(pDb->interp, zDb, -1)); - Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewStringObj(pDb->interp, zTbl, -1)); - Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewIntObj(pDb->interp, rowid)); - Jim_EvalObj(pDb->interp, pCmd); -} - -static void tclCollateNeeded( - void *pCtx, - sqlite3 *db, - int enc, - const char *zName -){ - SqliteDb *pDb = (SqliteDb *)pCtx; - Jim_Obj *pScript = Jim_DuplicateObj(pDb->interp, pDb->pCollateNeeded); - //Jim_IncrRefCount(pScript); - Jim_ListAppendElement(pDb->interp, pScript, Jim_NewStringObj(pDb->interp, zName, -1)); - Jim_EvalObj(pDb->interp, pScript); - //Jim_DecrRefCount(pDb->interp, pScript); -} - -/* -** This routine is called to evaluate an SQL collation function implemented -** using TCL script. -*/ -static int tclSqlCollate( - void *pCtx, - int nA, - const void *zA, - int nB, - const void *zB -){ - SqlCollate *p = (SqlCollate *)pCtx; - Jim_Obj *pCmd; - - pCmd = Jim_NewStringObj(p->interp, p->zScript, -1); - //Jim_IncrRefCount(pCmd); - Jim_ListAppendElement(p->interp, pCmd, Jim_NewStringObj(p->interp, zA, nA)); - Jim_ListAppendElement(p->interp, pCmd, Jim_NewStringObj(p->interp, zB, nB)); - Jim_EvalObj(p->interp, pCmd); - //Jim_DecrRefCount(interp, pCmd); - return (atoi(Jim_String(Jim_GetResult(p->interp)))); -} - -/* -** This routine is called to evaluate an SQL function implemented -** using TCL script. -*/ -static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ - SqlFunc *p = sqlite3_user_data(context); - Jim_Obj *pCmd; - int i; - int rc; - - if( argc==0 ){ - /* If there are no arguments to the function, call Jim_EvalObjEx on the - ** script object directly. This allows the TCL compiler to generate - ** bytecode for the command on the first invocation and thus make - ** subsequent invocations much faster. */ - pCmd = p->pScript; - //Jim_IncrRefCount(pCmd); - rc = Jim_EvalObj(p->interp, pCmd); - //Jim_DecrRefCount(interp, pCmd); - }else{ - /* If there are arguments to the function, make a shallow copy of the - ** script object, lappend the arguments, then evaluate the copy. - ** - ** By "shallow" copy, we mean a only the outer list Jim_Obj is duplicated. - ** The new Jim_Obj contains pointers to the original list elements. - ** That way, when Jim_EvalObjv() is run and shimmers the first element - ** of the list to tclCmdNameType, that alternate representation will - ** be preserved and reused on the next invocation. - */ - pCmd = Jim_DuplicateObj(p->interp, p->pScript); - Jim_IncrRefCount(pCmd); - for(i=0; iinterp, sqlite3_value_blob(pIn), bytes); - break; - } - case SQLITE_INTEGER: { - sqlite_int64 v = sqlite3_value_int64(pIn); - pVal = Jim_NewIntObj(p->interp, v); - break; - } - case SQLITE_FLOAT: { - double r = sqlite3_value_double(pIn); - pVal = Jim_NewDoubleObj(p->interp, r); - break; - } - case SQLITE_NULL: { - pVal = Jim_NewStringObj(p->interp, "", 0); - break; - } - default: { - int bytes = sqlite3_value_bytes(pIn); - pVal = Jim_NewStringObj(p->interp, (char *)sqlite3_value_text(pIn), bytes); - break; - } - } - Jim_ListAppendElement(p->interp, pCmd, pVal); - } - if( !p->useEvalObjv ){ - /* Jim_EvalOb() will automatically call Jim_EvalObjVector() if pCmd - ** is a list without a string representation. To prevent this from - ** happening, make sure pCmd has a valid string representation */ - Jim_String(pCmd); - } - rc = Jim_EvalObj(p->interp, pCmd); - Jim_DecrRefCount(p->interp, pCmd); - } - - if( rc && rc!=JIM_RETURN ){ - sqlite3_result_error(context, Jim_String(Jim_GetResult(p->interp)), -1); - }else{ - Jim_Obj *pVar = Jim_GetResult(p->interp); - int n; - u8 *data; - /* XXX: Jim Tcl doesn't have bytearray or boolean */ - const char *zType = (pVar->typePtr ? pVar->typePtr->name : ""); - char c = zType[0]; -#if 0 - if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ - /* Only return a BLOB type if the Tcl variable is a bytearray and - ** has no string representation. */ - data = Jim_GetByteArrayFromObj(pVar, &n); - sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT); - }else if( c=='b' && strcmp(zType,"boolean")==0 ){ - Jim_GetWide(0, pVar, &n); - sqlite3_result_int(context, n); - }else -#endif - if( c=='d' && strcmp(zType,"double")==0 ){ - double r; - Jim_GetDouble(0, pVar, &r); - sqlite3_result_double(context, r); - /* XXX: Is a cooerced double better as a double or an int? */ - }else if( (c=='c' && strcmp(zType,"coerced-double")==0) || - (c=='i' && strcmp(zType,"int")==0) ){ - jim_wide v; - Jim_GetWide(p->interp, pVar, &v); - sqlite3_result_int64(context, v); - }else{ - data = (unsigned char *)Jim_GetString(pVar, &n); - sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); - } - } -} - -#ifndef SQLITE_OMIT_AUTHORIZATION -/* -** This is the authentication function. It appends the authentication -** type code and the two arguments to zCmd[] then invokes the result -** on the interpreter. The reply is examined to determine if the -** authentication fails or succeeds. -*/ -static int auth_callback( - void *pArg, - int code, - const char *zArg1, - const char *zArg2, - const char *zArg3, - const char *zArg4 -){ - char *zCode; - Jim_Obj *str; - int rc; - const char *zReply; - SqliteDb *pDb = (SqliteDb*)pArg; - if( pDb->disableAuth ) return SQLITE_OK; - - switch( code ){ - case SQLITE_COPY : zCode="SQLITE_COPY"; break; - case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break; - case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break; - case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break; - case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break; - case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break; - case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break; - case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break; - case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break; - case SQLITE_DELETE : zCode="SQLITE_DELETE"; break; - case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break; - case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break; - case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break; - case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break; - case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break; - case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break; - case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break; - case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break; - case SQLITE_INSERT : zCode="SQLITE_INSERT"; break; - case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break; - case SQLITE_READ : zCode="SQLITE_READ"; break; - case SQLITE_SELECT : zCode="SQLITE_SELECT"; break; - case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break; - case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break; - case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break; - case SQLITE_DETACH : zCode="SQLITE_DETACH"; break; - case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break; - case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break; - case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break; - case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break; - case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break; - case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break; - case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break; - default : zCode="????"; break; - } - str = Jim_NewStringObj(pDb->interp, pDb->zAuth, -1); - /* XXX: list or string here? */ - Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zCode, -1)); - if (zArg1) { - Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg1, -1)); - } - if (zArg2) { - Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg2, -1)); - } - if (zArg3) { - Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg3, -1)); - } - if (zArg4) { - Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg4, -1)); - } - Jim_IncrRefCount(str); - rc = Jim_EvalGlobal(pDb->interp, Jim_String(str)); - Jim_DecrRefCount(pDb->interp, str); - zReply = Jim_String(Jim_GetResult(pDb->interp)); - if( strcmp(zReply,"SQLITE_OK")==0 ){ - rc = SQLITE_OK; - }else if( strcmp(zReply,"SQLITE_DENY")==0 ){ - rc = SQLITE_DENY; - }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){ - rc = SQLITE_IGNORE; - }else{ - rc = 999; - } - return rc; -} -#endif /* SQLITE_OMIT_AUTHORIZATION */ - -/* -** Note that Jim Tcl can't do encoding conversion, -** so this simply returns the string as an object. -*/ -static Jim_Obj *dbTextToObj(Jim_Interp *interp, char const *zText){ - return Jim_NewStringObj(interp, zText ? zText : "", -1); -} - -/* -** This routine reads a line of text from FILE in, stores -** the text in memory obtained from malloc() and returns a pointer -** to the text. NULL is returned at end of file. -** -** The interface is like "readline" but no command-line editing -** is done. -** -** copied from shell.c from '.import' command -*/ -static char *local_getline(char *zPrompt, FILE *in){ - char *zLine; - int nLine; - int n; - int eol; - - nLine = 100; - zLine = Jim_Alloc( nLine ); - n = 0; - eol = 0; - while( !eol ){ - if( n+100>nLine ){ - nLine = nLine*2 + 100; - zLine = Jim_Realloc(zLine, nLine); - if( zLine==0 ) return 0; - } - if( fgets(&zLine[n], nLine - n, in)==0 ){ - if( n==0 ){ - Jim_Free(zLine); - return 0; - } - zLine[n] = 0; - eol = 1; - break; - } - while( zLine[n] ){ n++; } - if( n>0 && zLine[n-1]=='\n' ){ - n--; - zLine[n] = 0; - eol = 1; - } - } - zLine = Jim_Realloc( zLine, n+1 ); - return zLine; -} - - -/* -** This function is part of the implementation of the command: -** -** $db transaction [-deferred|-immediate|-exclusive] SCRIPT -** -** It is invoked after evaluating the script SCRIPT to commit or rollback -** the transaction or savepoint opened by the [transaction] command. -*/ -static int DbTransPostCmd( - Jim_Interp *interp, /* Tcl interpreter */ - SqliteDb *pDb, - int result /* Result of evaluating SCRIPT */ -){ - static const char *azEnd[] = { - "RELEASE _tcl_transaction", /* rc==JIM_ERR, nTransaction!=0 */ - "COMMIT", /* rc!=JIM_ERR, nTransaction==0 */ - "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction", - "ROLLBACK" /* rc==JIM_ERR, nTransaction==0 */ - }; - int rc = result; - const char *zEnd; - - pDb->nTransaction--; - zEnd = azEnd[(rc==JIM_ERR)*2 + (pDb->nTransaction==0)]; - - pDb->disableAuth++; - if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){ - /* This is a tricky scenario to handle. The most likely cause of an - ** error is that the exec() above was an attempt to commit the - ** top-level transaction that returned SQLITE_BUSY. Or, less likely, - ** that an IO-error has occured. In either case, throw a Tcl exception - ** and try to rollback the transaction. - ** - ** But it could also be that the user executed one or more BEGIN, - ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing - ** this method's logic. Not clear how this would be best handled. - */ - if( rc!=JIM_ERR ){ - Jim_AppendString(interp, Jim_GetResult(interp), sqlite3_errmsg(pDb->db), -1); - rc = JIM_ERR; - } - sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0); - } - pDb->disableAuth--; - - return rc; -} - -/* -** Search the cache for a prepared-statement object that implements the -** first SQL statement in the buffer pointed to by parameter zIn. If -** no such prepared-statement can be found, allocate and prepare a new -** one. In either case, bind the current values of the relevant Tcl -** variables to any $var, :var or @var variables in the statement. Before -** returning, set *ppPreStmt to point to the prepared-statement object. -** -** Output parameter *pzOut is set to point to the next SQL statement in -** buffer zIn, or to the '\0' byte at the end of zIn if there is no -** next statement. -** -** If successful, JIM_OK is returned. Otherwise, JIM_ERR is returned -** and an error message loaded into interpreter pDb->interp. -*/ -static int dbPrepareAndBind( - SqliteDb *pDb, /* Database object */ - char const *zIn, /* SQL to compile */ - char const **pzOut, /* OUT: Pointer to next SQL statement */ - SqlPreparedStmt **ppPreStmt /* OUT: Object used to cache statement */ -){ - const char *zSql = zIn; /* Pointer to first SQL statement in zIn */ - sqlite3_stmt *pStmt; /* Prepared statement object */ - SqlPreparedStmt *pPreStmt; /* Pointer to cached statement */ - int nSql; /* Length of zSql in bytes */ - int nVar; /* Number of variables in statement */ - int iParm = 0; /* Next free entry in apParm */ - int i; - Jim_Interp *interp = pDb->interp; - - *ppPreStmt = 0; - - /* Trim spaces from the start of zSql and calculate the remaining length. */ - while( isspace((unsigned)zSql[0]) ){ zSql++; } - nSql = strlen30(zSql); - - for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){ - int n = pPreStmt->nSql; - if( nSql>=n - && memcmp(pPreStmt->zSql, zSql, n)==0 - && (zSql[n]==0 || zSql[n-1]==';') - ){ - pStmt = pPreStmt->pStmt; - *pzOut = &zSql[pPreStmt->nSql]; - - /* When a prepared statement is found, unlink it from the - ** cache list. It will later be added back to the beginning - ** of the cache list in order to implement LRU replacement. - */ - if( pPreStmt->pPrev ){ - pPreStmt->pPrev->pNext = pPreStmt->pNext; - }else{ - pDb->stmtList = pPreStmt->pNext; - } - if( pPreStmt->pNext ){ - pPreStmt->pNext->pPrev = pPreStmt->pPrev; - }else{ - pDb->stmtLast = pPreStmt->pPrev; - } - pDb->nStmt--; - nVar = sqlite3_bind_parameter_count(pStmt); - break; - } - } - - /* If no prepared statement was found. Compile the SQL text. Also allocate - ** a new SqlPreparedStmt structure. */ - if( pPreStmt==0 ){ - int nByte; - - if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, pzOut) ){ - Jim_SetResult(interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db))); - return JIM_ERR; - } - if( pStmt==0 ){ - if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){ - /* A compile-time error in the statement. */ - Jim_SetResult(interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db))); - return JIM_ERR; - }else{ - /* The statement was a no-op. Continue to the next statement - ** in the SQL string. - */ - return JIM_OK; - } - } - - assert( pPreStmt==0 ); - nVar = sqlite3_bind_parameter_count(pStmt); - nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Jim_Obj *); - pPreStmt = (SqlPreparedStmt*)Jim_Alloc(nByte); - memset(pPreStmt, 0, nByte); - - pPreStmt->pStmt = pStmt; - pPreStmt->nSql = (*pzOut - zSql); - pPreStmt->zSql = sqlite3_sql(pStmt); - pPreStmt->apParm = (Jim_Obj **)&pPreStmt[1]; - } - assert( pPreStmt ); - assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql ); - assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) ); - - /* Bind values to parameters that begin with $ or : */ - for(i=1; i<=nVar; i++){ - const char *zVar = sqlite3_bind_parameter_name(pStmt, i); - if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){ - Jim_Obj *pVar = Jim_GetVariableStr(interp, &zVar[1], 0); - if( pVar ){ - int n; - u8 *data; - const char *zType = (pVar->typePtr ? pVar->typePtr->name : ""); - char c = zType[0]; - /* XXX: Jim Tcl doesn't have bytearray or boolean */ - if( zVar[0]=='@') { -#if 0 - || - (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){ - /* Load a BLOB type if the Tcl variable is a bytearray and - ** it has no string representation or the host - ** parameter name begins with "@". */ - data = Jim_GetByteArrayFromObj(pVar, &n); -#else - data = (unsigned char *)Jim_GetString(pVar, &n); -#endif - sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC); - Jim_IncrRefCount(pVar); - pPreStmt->apParm[iParm++] = pVar; -#if 0 - }else if( c=='b' && strcmp(zType,"boolean")==0 ){ - Jim_GetWide(interp, pVar, &n); - sqlite3_bind_int(pStmt, i, n); -#endif - }else if( c=='d' && strcmp(zType,"double")==0 ){ - double r; - Jim_GetDouble(interp, pVar, &r); - sqlite3_bind_double(pStmt, i, r); - }else if( (c=='c' && strcmp(zType,"coerced-double")==0) || - (c=='i' && strcmp(zType,"int")==0) ){ - jim_wide v; - Jim_GetWide(interp, pVar, &v); - sqlite3_bind_int64(pStmt, i, v); - }else{ - data = (unsigned char *)Jim_GetString(pVar, &n); - sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC); - Jim_IncrRefCount(pVar); - pPreStmt->apParm[iParm++] = pVar; - } - }else{ - sqlite3_bind_null(pStmt, i); - } - } - } - pPreStmt->nParm = iParm; - *ppPreStmt = pPreStmt; - - return JIM_OK; -} - - -/* -** Release a statement reference obtained by calling dbPrepareAndBind(). -** There should be exactly one call to this function for each call to -** dbPrepareAndBind(). -** -** If the discard parameter is non-zero, then the statement is deleted -** immediately. Otherwise it is added to the LRU list and may be returned -** by a subsequent call to dbPrepareAndBind(). -*/ -static void dbReleaseStmt( - SqliteDb *pDb, /* Database handle */ - SqlPreparedStmt *pPreStmt, /* Prepared statement handle to release */ - int discard /* True to delete (not cache) the pPreStmt */ -){ - int i; - - /* Free the bound string and blob parameters */ - for(i=0; inParm; i++){ - Jim_DecrRefCount(pDb->interp, pPreStmt->apParm[i]); - } - pPreStmt->nParm = 0; - - if( pDb->maxStmt<=0 || discard ){ - /* If the cache is turned off, deallocated the statement */ - sqlite3_finalize(pPreStmt->pStmt); - Jim_Free((char *)pPreStmt); - }else{ - /* Add the prepared statement to the beginning of the cache list. */ - pPreStmt->pNext = pDb->stmtList; - pPreStmt->pPrev = 0; - if( pDb->stmtList ){ - pDb->stmtList->pPrev = pPreStmt; - } - pDb->stmtList = pPreStmt; - if( pDb->stmtLast==0 ){ - assert( pDb->nStmt==0 ); - pDb->stmtLast = pPreStmt; - }else{ - assert( pDb->nStmt>0 ); - } - pDb->nStmt++; - - /* If we have too many statement in cache, remove the surplus from - ** the end of the cache list. */ - while( pDb->nStmt>pDb->maxStmt ){ - sqlite3_finalize(pDb->stmtLast->pStmt); - pDb->stmtLast = pDb->stmtLast->pPrev; - Jim_Free((char*)pDb->stmtLast->pNext); - pDb->stmtLast->pNext = 0; - pDb->nStmt--; - } - } -} - -/* -** Structure used with dbEvalXXX() functions: -** -** dbEvalInit() -** dbEvalStep() -** dbEvalFinalize() -** dbEvalRowInfo() -** dbEvalColumnValue() -*/ -typedef struct DbEvalContext DbEvalContext; -struct DbEvalContext { - SqliteDb *pDb; /* Database handle */ - Jim_Obj *pSql; /* Object holding string zSql */ - const char *zSql; /* Remaining SQL to execute */ - SqlPreparedStmt *pPreStmt; /* Current statement */ - int nCol; /* Number of columns returned by pStmt */ - Jim_Obj *pArray; /* Name of array variable */ - Jim_Obj **apColName; /* Array of column names */ -}; - -/* -** Release any cache of column names currently held as part of -** the DbEvalContext structure passed as the first argument. -*/ -static void dbReleaseColumnNames(DbEvalContext *p){ - if( p->apColName ){ - int i; - for(i=0; inCol; i++){ - Jim_DecrRefCount(p->pDb->interp, p->apColName[i]); - } - Jim_Free((char *)p->apColName); - p->apColName = 0; - } - p->nCol = 0; -} - -/* -** Initialize a DbEvalContext structure. -** -** If pArray is not NULL, then it contains the name of a Tcl array -** variable. The "*" member of this array is set to a list containing -** the names of the columns returned by the statement as part of each -** call to dbEvalStep(), in order from left to right. e.g. if the names -** of the returned columns are a, b and c, it does the equivalent of the -** tcl command: -** -** set ${pArray}(*) {a b c} -*/ -static void dbEvalInit( - DbEvalContext *p, /* Pointer to structure to initialize */ - SqliteDb *pDb, /* Database handle */ - Jim_Obj *pSql, /* Object containing SQL script */ - Jim_Obj *pArray /* Name of Tcl array to set (*) element of */ -){ - memset(p, 0, sizeof(DbEvalContext)); - p->pDb = pDb; - p->zSql = Jim_String(pSql); - p->pSql = pSql; - Jim_IncrRefCount(pSql); - if( pArray ){ - p->pArray = pArray; - Jim_IncrRefCount(pArray); - } -} - -/* -** Obtain information about the row that the DbEvalContext passed as the -** first argument currently points to. -*/ -static void dbEvalRowInfo( - DbEvalContext *p, /* Evaluation context */ - int *pnCol, /* OUT: Number of column names */ - Jim_Obj ***papColName /* OUT: Array of column names */ -){ - /* Compute column names */ - if( 0==p->apColName ){ - sqlite3_stmt *pStmt = p->pPreStmt->pStmt; - int i; /* Iterator variable */ - int nCol; /* Number of columns returned by pStmt */ - Jim_Obj **apColName = 0; /* Array of column names */ - - p->nCol = nCol = sqlite3_column_count(pStmt); - if( nCol>0 && (papColName || p->pArray) ){ - apColName = (Jim_Obj**)Jim_Alloc( sizeof(Jim_Obj*)*nCol ); - for(i=0; ipDb->interp, sqlite3_column_name(pStmt,i)); - Jim_IncrRefCount(apColName[i]); - } - p->apColName = apColName; - } - - /* If results are being stored in an array variable, then create - ** the array(*) entry for that array - */ - if( p->pArray ){ - Jim_Interp *interp = p->pDb->interp; - Jim_Obj *pColList = Jim_NewListObj(interp, apColName, nCol); - Jim_Obj *pStar = Jim_NewStringObj(interp, "*", -1); - Jim_IncrRefCount(pStar); - Jim_SetDictKeysVector(interp, p->pArray, &pStar, 1, pColList, 0); - Jim_DecrRefCount(interp, pStar); - } - } - - if( papColName ){ - *papColName = p->apColName; - } - if( pnCol ){ - *pnCol = p->nCol; - } -} - -/* -** Return one of JIM_OK, JIM_BREAK or JIM_ERR. If JIM_ERR is -** returned, then an error message is stored in the interpreter before -** returning. -** -** A return value of JIM_OK means there is a row of data available. The -** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This -** is analogous to a return of SQLITE_ROW from sqlite3_step(). If JIM_BREAK -** is returned, then the SQL script has finished executing and there are -** no further rows available. This is similar to SQLITE_DONE. -*/ -static int dbEvalStep(DbEvalContext *p){ - while( p->zSql[0] || p->pPreStmt ){ - int rc; - if( p->pPreStmt==0 ){ - rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt); - if( rc!=JIM_OK ) return rc; - }else{ - int rcs; - SqliteDb *pDb = p->pDb; - SqlPreparedStmt *pPreStmt = p->pPreStmt; - sqlite3_stmt *pStmt = pPreStmt->pStmt; - - rcs = sqlite3_step(pStmt); - if( rcs==SQLITE_ROW ){ - return JIM_OK; - } - if( p->pArray ){ - dbEvalRowInfo(p, 0, 0); - } - rcs = sqlite3_reset(pStmt); - - pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1); - pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1); - dbReleaseColumnNames(p); - p->pPreStmt = 0; - - if( rcs!=SQLITE_OK ){ - /* If a run-time error occurs, report the error and stop reading - ** the SQL. */ - Jim_SetResult(pDb->interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db))); - dbReleaseStmt(pDb, pPreStmt, 1); - return JIM_ERR; - }else{ - dbReleaseStmt(pDb, pPreStmt, 0); - } - } - } - - /* Finished */ - return JIM_BREAK; -} - -/* -** Free all resources currently held by the DbEvalContext structure passed -** as the first argument. There should be exactly one call to this function -** for each call to dbEvalInit(). -*/ -static void dbEvalFinalize(DbEvalContext *p){ - if( p->pPreStmt ){ - sqlite3_reset(p->pPreStmt->pStmt); - dbReleaseStmt(p->pDb, p->pPreStmt, 0); - p->pPreStmt = 0; - } - if( p->pArray ){ - Jim_DecrRefCount(p->pDb->interp, p->pArray); - p->pArray = 0; - } - Jim_DecrRefCount(p->pDb->interp, p->pSql); - dbReleaseColumnNames(p); -} - -/* -** Return a pointer to a Jim_Obj structure with ref-count 0 that contains -** the value for the iCol'th column of the row currently pointed to by -** the DbEvalContext structure passed as the first argument. -*/ -static Jim_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){ - sqlite3_stmt *pStmt = p->pPreStmt->pStmt; - switch( sqlite3_column_type(pStmt, iCol) ){ - case SQLITE_BLOB: { - int bytes = sqlite3_column_bytes(pStmt, iCol); - const char *zBlob = sqlite3_column_blob(pStmt, iCol); - if( !zBlob ) bytes = 0; - //return Jim_NewByteArrayObj((u8*)zBlob, bytes); - return Jim_NewStringObj(p->pDb->interp, zBlob, bytes); - } - case SQLITE_INTEGER: { - sqlite_int64 v = sqlite3_column_int64(pStmt, iCol); - return Jim_NewIntObj(p->pDb->interp, v); - } - case SQLITE_FLOAT: { - return Jim_NewDoubleObj(p->pDb->interp, sqlite3_column_double(pStmt, iCol)); - } - case SQLITE_NULL: { - return dbTextToObj(p->pDb->interp, p->pDb->zNull); - } - } - - return dbTextToObj(p->pDb->interp, (char *)sqlite3_column_text(pStmt, iCol)); -} - -static int Jim_ObjSetVar2(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *keyObjPtr, Jim_Obj *valObjPtr) -{ - return Jim_SetDictKeysVector(interp, nameObjPtr, &keyObjPtr, 1, valObjPtr, 0); -} - -/* -** This function is part of the implementation of the command: -** -** $db eval SQL ?ARRAYNAME? SCRIPT -*/ -static int DbEvalNextCmd( - Jim_Interp *interp, /* Tcl interpreter */ - DbEvalContext *p, - Jim_Obj *pScript, - int result /* Result so far */ -){ - int rc = result; /* Return code */ - - Jim_Obj *pArray = p->pArray; - - while( (rc==JIM_OK || rc==JIM_CONTINUE) && JIM_OK==(rc = dbEvalStep(p)) ){ - int i; - int nCol; - Jim_Obj **apColName; - dbEvalRowInfo(p, &nCol, &apColName); - for(i=0; i3 ){ - Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); - return JIM_ERR; - }else if( objc==2 ){ - if( pDb->zAuth ){ - Jim_SetResultString(interp, pDb->zAuth, -1); - } - }else{ - const char *zAuth; - int len; - if( pDb->zAuth ){ - Jim_Free(pDb->zAuth); - } - zAuth = Jim_GetString(objv[2], &len); - if( zAuth && len>0 ){ - pDb->zAuth = Jim_Alloc( len + 1 ); - memcpy(pDb->zAuth, zAuth, len+1); - }else{ - pDb->zAuth = 0; - } - if( pDb->zAuth ){ - pDb->interp = interp; - sqlite3_set_authorizer(pDb->db, auth_callback, pDb); - }else{ - sqlite3_set_authorizer(pDb->db, 0, 0); - } - } -#endif - break; - } - - /* $db backup ?DATABASE? FILENAME - ** - ** Open or create a database file named FILENAME. Transfer the - ** content of local database DATABASE (default: "main") into the - ** FILENAME database. - */ - case DB_BACKUP: { - const char *zDestFile; - const char *zSrcDb; - sqlite3 *pDest; - sqlite3_backup *pBackup; - - if( objc==3 ){ - zSrcDb = "main"; - zDestFile = Jim_String(objv[2]); - }else if( objc==4 ){ - zSrcDb = Jim_String(objv[2]); - zDestFile = Jim_String(objv[3]); - }else{ - Jim_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); - return JIM_ERR; - } - rc = sqlite3_open(zDestFile, &pDest); - if( rc!=SQLITE_OK ){ - Jim_SetResultFormatted(interp, "cannot open target database: %s", sqlite3_errmsg(pDest)); - sqlite3_close(pDest); - return JIM_ERR; - } - pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb); - if( pBackup==0 ){ - Jim_SetResultFormatted(interp, "backup failed: %s", sqlite3_errmsg(pDest)); - sqlite3_close(pDest); - return JIM_ERR; - } - while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){} - sqlite3_backup_finish(pBackup); - if( rc==SQLITE_DONE ){ - rc = JIM_OK; - }else{ - Jim_SetResultFormatted(interp, "backup failed: %s", sqlite3_errmsg(pDest)); - rc = JIM_ERR; - } - sqlite3_close(pDest); - break; - } - - /* $db busy ?CALLBACK? - ** - ** Invoke the given callback if an SQL statement attempts to open - ** a locked database file. - */ - case DB_BUSY: { - if( objc>3 ){ - Jim_WrongNumArgs(interp, 2, objv, "CALLBACK"); - return JIM_ERR; - }else if( objc==2 ){ - if( pDb->zBusy ){ - Jim_SetResultString(interp, pDb->zBusy, -1); - } - }else{ - const char *zBusy; - int len; - if( pDb->zBusy ){ - Jim_Free(pDb->zBusy); - } - zBusy = Jim_GetString(objv[2], &len); - if( zBusy && len>0 ){ - pDb->zBusy = Jim_Alloc( len + 1 ); - memcpy(pDb->zBusy, zBusy, len+1); - }else{ - pDb->zBusy = 0; - } - if( pDb->zBusy ){ - pDb->interp = interp; - sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb); - }else{ - sqlite3_busy_handler(pDb->db, 0, 0); - } - } - break; - } - - /* $db cache flush - ** $db cache size n - ** - ** Flush the prepared statement cache, or set the maximum number of - ** cached statements. - */ - case DB_CACHE: { - const char *subCmd; - - if( objc<=2 ){ - Jim_WrongNumArgs(interp, 1, objv, "cache option ?arg?"); - return JIM_ERR; - } - subCmd = Jim_String( objv[2]); - if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){ - if( objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "flush"); - return JIM_ERR; - }else{ - flushStmtCache( pDb ); - } - }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){ - if( objc!=4 ){ - Jim_WrongNumArgs(interp, 2, objv, "size n"); - return JIM_ERR; - }else{ - jim_wide w; - if( JIM_ERR==Jim_GetWide(interp, objv[3], &w) ){ - return JIM_ERR; - }else{ - if( w<0 ){ - flushStmtCache( pDb ); - w = 0; - }else if( w>MAX_PREPARED_STMTS ){ - w = MAX_PREPARED_STMTS; - } - pDb->maxStmt = w; - } - } - }else{ - Jim_SetResultFormatted(interp, "bad option \"%#s\": must be flush or size", objv[2]); - return JIM_ERR; - } - break; - } - - /* $db changes - ** - ** Return the number of rows that were modified, inserted, or deleted by - ** the most recent INSERT, UPDATE or DELETE statement, not including - ** any changes made by trigger programs. - */ - case DB_CHANGES: { - if( objc!=2 ){ - Jim_WrongNumArgs(interp, 2, objv, ""); - return JIM_ERR; - } - Jim_SetResultInt(interp, sqlite3_changes(pDb->db)); - break; - } - - /* $db close - ** - ** Shutdown the database - */ - case DB_CLOSE: { - Jim_DeleteCommand(interp, Jim_String(objv[0])); - break; - } - - /* - ** $db collate NAME SCRIPT - ** - ** Create a new SQL collation function called NAME. Whenever - ** that function is called, invoke SCRIPT to evaluate the function. - */ - case DB_COLLATE: { - SqlCollate *pCollate; - const char *zName; - const char *zScript; - int nScript; - if( objc!=4 ){ - Jim_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); - return JIM_ERR; - } - zName = Jim_String(objv[2]); - zScript = Jim_GetString(objv[3], &nScript); - pCollate = (SqlCollate*)Jim_Alloc( sizeof(*pCollate) + nScript + 1 ); - if( pCollate==0 ) return JIM_ERR; - pCollate->interp = interp; - pCollate->pNext = pDb->pCollate; - pCollate->zScript = (char*)&pCollate[1]; - pDb->pCollate = pCollate; - memcpy(pCollate->zScript, zScript, nScript+1); - if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, - pCollate, tclSqlCollate) ){ - Jim_SetResultString(interp, (char *)sqlite3_errmsg(pDb->db), -1); - return JIM_ERR; - } - break; - } - - /* - ** $db collation_needed SCRIPT - ** - ** Create a new SQL collation function called NAME. Whenever - ** that function is called, invoke SCRIPT to evaluate the function. - */ - case DB_COLLATION_NEEDED: { - if( objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "SCRIPT"); - return JIM_ERR; - } - if( pDb->pCollateNeeded ){ - Jim_DecrRefCount(interp, pDb->pCollateNeeded); - } - pDb->pCollateNeeded = Jim_DuplicateObj(pDb->interp, objv[2]); - Jim_IncrRefCount(pDb->pCollateNeeded); - sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded); - break; - } - - /* $db commit_hook ?CALLBACK? - ** - ** Invoke the given callback just before committing every SQL transaction. - ** If the callback throws an exception or returns non-zero, then the - ** transaction is aborted. If CALLBACK is an empty string, the callback - ** is disabled. - */ - case DB_COMMIT_HOOK: { - if( objc>3 ){ - Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); - return JIM_ERR; - }else if( objc==2 ){ - if( pDb->zCommit ){ - Jim_SetResultString(interp, pDb->zCommit, -1); - } - }else{ - const char *zCommit; - int len; - if( pDb->zCommit ){ - Jim_Free(pDb->zCommit); - } - zCommit = Jim_GetString(objv[2], &len); - if( zCommit && len>0 ){ - pDb->zCommit = Jim_Alloc( len + 1 ); - memcpy(pDb->zCommit, zCommit, len+1); - }else{ - pDb->zCommit = 0; - } - if( pDb->zCommit ){ - pDb->interp = interp; - sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb); - }else{ - sqlite3_commit_hook(pDb->db, 0, 0); - } - } - break; - } - - /* $db complete SQL - ** - ** Return TRUE if SQL is a complete SQL statement. Return FALSE if - ** additional lines of input are needed. This is similar to the - ** built-in "info complete" command of Tcl. - */ - case DB_COMPLETE: { -#ifndef SQLITE_OMIT_COMPLETE - if( objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "SQL"); - return JIM_ERR; - } - Jim_SetResultInt(interp, sqlite3_complete( Jim_String(objv[2]) )); -#endif - break; - } - - /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR? - ** - ** Copy data into table from filename, optionally using SEPARATOR - ** as column separators. If a column contains a null string, or the - ** value of NULLINDICATOR, a NULL is inserted for the column. - ** conflict-algorithm is one of the sqlite conflict algorithms: - ** rollback, abort, fail, ignore, replace - ** On success, return the number of lines processed, not necessarily same - ** as 'db changes' due to conflict-algorithm selected. - ** - ** This code is basically an implementation/enhancement of - ** the sqlite3 shell.c ".import" command. - ** - ** This command usage is equivalent to the sqlite2.x COPY statement, - ** which imports file data into a table using the PostgreSQL COPY file format: - ** $db copy $conflit_algo $table_name $filename \t \\N - */ - case DB_COPY: { - const char *zTable; /* Insert data into this table */ - const char *zFile; /* The file from which to extract data */ - const char *zConflict; /* The conflict algorithm to use */ - sqlite3_stmt *pStmt; /* A statement */ - int nCol; /* Number of columns in the table */ - int nByte; /* Number of bytes in an SQL string */ - int i, j; /* Loop counters */ - int nSep; /* Number of bytes in zSep[] */ - int nNull; /* Number of bytes in zNull[] */ - char *zSql; /* An SQL statement */ - char *zLine; /* A single line of input from the file */ - char **azCol; /* zLine[] broken up into columns */ - char *zCommit; /* How to commit changes */ - FILE *in; /* The input file */ - int lineno = 0; /* Line number of input file */ - char zLineNum[80]; /* Line number print buffer */ - - const char *zSep; - const char *zNull; - if( objc<5 || objc>7 ){ - Jim_WrongNumArgs(interp, 2, objv, - "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"); - return JIM_ERR; - } - if( objc>=6 ){ - zSep = Jim_String(objv[5]); - }else{ - zSep = "\t"; - } - if( objc>=7 ){ - zNull = Jim_String(objv[6]); - }else{ - zNull = ""; - } - zConflict = Jim_String(objv[2]); - zTable = Jim_String(objv[3]); - zFile = Jim_String(objv[4]); - nSep = strlen30(zSep); - nNull = strlen30(zNull); - if( nSep==0 ){ - Jim_SetResultString(interp, "Error: non-null separator required for copy", -1); - return JIM_ERR; - } - if(strcmp(zConflict, "rollback") != 0 && - strcmp(zConflict, "abort" ) != 0 && - strcmp(zConflict, "fail" ) != 0 && - strcmp(zConflict, "ignore" ) != 0 && - strcmp(zConflict, "replace" ) != 0 ) { - Jim_SetResultFormatted(interp, "Error: \"%s\", conflict-algorithm must be one of: rollback, " - "abort, fail, ignore, or replace", zConflict); - return JIM_ERR; - } - zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable); - if( zSql==0 ){ - Jim_SetResultFormatted(interp, "Error: no such table: %s", zTable); - return JIM_ERR; - } - nByte = strlen30(zSql); - rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); - sqlite3_free(zSql); - if( rc ){ - Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db)); - nCol = 0; - }else{ - nCol = sqlite3_column_count(pStmt); - } - sqlite3_finalize(pStmt); - if( nCol==0 ) { - return JIM_ERR; - } - zSql = Jim_Alloc( nByte + 50 + nCol*2 ); - sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?", - zConflict, zTable); - j = strlen30(zSql); - for(i=1; idb, zSql, -1, &pStmt, 0); - Jim_Free(zSql); - if( rc ){ - Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db)); - sqlite3_finalize(pStmt); - return JIM_ERR; - } - in = fopen(zFile, "rb"); - if( in==0 ){ - Jim_SetResultFormatted(interp, "Error: cannot open file: %s", zFile); - sqlite3_finalize(pStmt); - return JIM_ERR; - } - azCol = Jim_Alloc( sizeof(azCol[0])*(nCol+1) ); - (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0); - zCommit = "COMMIT"; - while( (zLine = local_getline(0, in))!=0 ){ - char *z; - i = 0; - lineno++; - azCol[0] = zLine; - for(i=0, z=zLine; *z; z++){ - if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){ - *z = 0; - i++; - if( i0 && strcmp(azCol[i], zNull)==0) - || strlen30(azCol[i])==0 - ){ - sqlite3_bind_null(pStmt, i+1); - }else{ - sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC); - } - } - sqlite3_step(pStmt); - rc = sqlite3_reset(pStmt); - Jim_Free(zLine); - if( rc!=SQLITE_OK ){ - Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db)); - zCommit = "ROLLBACK"; - break; - } - } - Jim_Free(azCol); - fclose(in); - sqlite3_finalize(pStmt); - (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0); - - if( zCommit[0] == 'C' ){ - /* success, set result as number of lines processed */ - Jim_SetResultInt(interp, lineno); - rc = JIM_OK; - }else{ - /* failure, append lineno where failed */ - sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno); - Jim_AppendStrings(interp, Jim_GetResult(interp), ", failed while processing line: ", zLineNum, NULL); - rc = JIM_ERR; - } - break; - } - - /* - ** $db enable_load_extension BOOLEAN - ** - ** Turn the extension loading feature on or off. It if off by - ** default. - */ - case DB_ENABLE_LOAD_EXTENSION: { -#ifndef SQLITE_OMIT_LOAD_EXTENSION - long onoff; - if( objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "BOOLEAN"); - return JIM_ERR; - } - if( Jim_GetLong(interp, objv[2], &onoff) ){ - return JIM_ERR; - } - sqlite3_enable_load_extension(pDb->db, onoff); - break; -#else - Jim_SetResultString(interp, "extension loading is turned off at compile-time", -1); - return JIM_ERR; -#endif - } - - /* - ** $db errorcode - ** - ** Return the numeric error code that was returned by the most recent - ** call to sqlite3_exec(). - */ - case DB_ERRORCODE: { - Jim_SetResultInt(interp, sqlite3_errcode(pDb->db)); - break; - } - - /* - ** $db exists $sql - ** $db onecolumn $sql - ** - ** The onecolumn method is the equivalent of: - ** lindex [$db eval $sql] 0 - */ - case DB_EXISTS: - case DB_ONECOLUMN: { - DbEvalContext sEval; - if( objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "SQL"); - return JIM_ERR; - } - - dbEvalInit(&sEval, pDb, objv[2], 0); - rc = dbEvalStep(&sEval); - if( choice==DB_ONECOLUMN ){ - if( rc==JIM_OK ){ - Jim_SetResult(interp, dbEvalColumnValue(&sEval, 0)); - } - }else if( rc==JIM_BREAK || rc==JIM_OK ){ - Jim_SetResultInt(interp, rc==JIM_OK); - } - dbEvalFinalize(&sEval); - - if( rc==JIM_BREAK ){ - rc = JIM_OK; - } - break; - } - - /* - ** $db eval $sql ?array? ?{ ...code... }? - ** - ** The SQL statement in $sql is evaluated. For each row, the values are - ** placed in elements of the array named "array" and ...code... is executed. - ** If "array" and "code" are omitted, then no callback is every invoked. - ** If "array" is an empty string, then the values are placed in variables - ** that have the same name as the fields extracted by the query. - */ - case DB_EVAL: { - if( objc<3 || objc>5 ){ - Jim_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?"); - return JIM_ERR; - } - - if( objc==3 ){ - DbEvalContext sEval; - Jim_Obj *pRet = Jim_NewListObj(interp, NULL, 0); - Jim_IncrRefCount(pRet); - dbEvalInit(&sEval, pDb, objv[2], 0); - while( JIM_OK==(rc = dbEvalStep(&sEval)) ){ - int i; - int nCol; - dbEvalRowInfo(&sEval, &nCol, 0); - for(i=0; i2 && strncmp(z, "-argcount",n)==0 ){ - if( Jim_GetLong(interp, objv[4], &nArg) ) return JIM_ERR; - if( nArg<0 ){ - Jim_SetResultString(interp, "number of arguments must be non-negative", -1); - return JIM_ERR; - } - } - pScript = objv[5]; - }else if( objc!=4 ){ - Jim_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT"); - return JIM_ERR; - }else{ - pScript = objv[3]; - } - zName = Jim_String(objv[2]); - pFunc = findSqlFunc(pDb, zName); - if( pFunc==0 ) return JIM_ERR; - if( pFunc->pScript ){ - Jim_DecrRefCount(interp, pFunc->pScript); - } - pFunc->pScript = pScript; - Jim_IncrRefCount(pScript); - pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); - rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8, - pFunc, tclSqlFunc, 0, 0); - if( rc!=SQLITE_OK ){ - rc = JIM_ERR; - Jim_SetResultString(interp, (char *)sqlite3_errmsg(pDb->db), -1); - } - break; - } - - /* - ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID - */ - case DB_INCRBLOB: { -#ifdef SQLITE_OMIT_INCRBLOB - Jim_SetResultString(interp, "incrblob not available in this build", -1); - return JIM_ERR; -#else - int isReadonly = 0; - const char *zDb = "main"; - const char *zTable; - const char *zColumn; - sqlite_int64 iRow; - - /* Check for the -readonly option */ - if( objc>3 && strcmp(Jim_GetString(objv[2]), "-readonly")==0 ){ - isReadonly = 1; - } - - if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){ - Jim_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID"); - return JIM_ERR; - } - - if( objc==(6+isReadonly) ){ - zDb = Jim_GetString(objv[2]); - } - zTable = Jim_GetString(objv[objc-3]); - zColumn = Jim_GetString(objv[objc-2]); - rc = Jim_GetWide(interp, objv[objc-1], &iRow); - - if( rc==JIM_OK ){ - rc = createIncrblobChannel( - interp, pDb, zDb, zTable, zColumn, iRow, isReadonly - ); - } -#endif - break; - } - - /* - ** $db interrupt - ** - ** Interrupt the execution of the inner-most SQL interpreter. This - ** causes the SQL statement to return an error of SQLITE_INTERRUPT. - */ - case DB_INTERRUPT: { - sqlite3_interrupt(pDb->db); - break; - } - - /* - ** $db nullvalue ?STRING? - ** - ** Change text used when a NULL comes back from the database. If ?STRING? - ** is not present, then the current string used for NULL is returned. - ** If STRING is present, then STRING is returned. - ** - */ - case DB_NULLVALUE: { - if( objc!=2 && objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "NULLVALUE"); - return JIM_ERR; - } - if( objc==3 ){ - int len; - const char *zNull = Jim_GetString(objv[2], &len); - if( pDb->zNull ){ - Jim_Free(pDb->zNull); - } - if( zNull && len>0 ){ - pDb->zNull = Jim_Alloc( len + 1 ); - strncpy(pDb->zNull, zNull, len); - pDb->zNull[len] = '\0'; - }else{ - pDb->zNull = 0; - } - } - Jim_SetResult(interp, dbTextToObj(interp, pDb->zNull)); - break; - } - - /* - ** $db last_insert_rowid - ** - ** Return an integer which is the ROWID for the most recent insert. - */ - case DB_LAST_INSERT_ROWID: { - if( objc!=2 ){ - Jim_WrongNumArgs(interp, 2, objv, ""); - return JIM_ERR; - } - Jim_SetResultInt(interp, sqlite3_last_insert_rowid(pDb->db)); - break; - } - - /* - ** The DB_ONECOLUMN method is implemented together with DB_EXISTS. - */ - - /* $db progress ?N CALLBACK? - ** - ** Invoke the given callback every N virtual machine opcodes while executing - ** queries. - */ - case DB_PROGRESS: { - if( objc==2 ){ - if( pDb->zProgress ){ - Jim_AppendString(interp, Jim_GetResult(interp), pDb->zProgress, -1); - } - }else if( objc==4 ){ - const char *zProgress; - int len; - long N; - if( JIM_OK!=Jim_GetLong(interp, objv[2], &N) ){ - return JIM_ERR; - }; - if( pDb->zProgress ){ - Jim_Free(pDb->zProgress); - } - zProgress = Jim_GetString(objv[3], &len); - if( zProgress && len>0 ){ - pDb->zProgress = Jim_Alloc( len + 1 ); - memcpy(pDb->zProgress, zProgress, len+1); - }else{ - pDb->zProgress = 0; - } -#ifndef SQLITE_OMIT_PROGRESS_CALLBACK - if( pDb->zProgress ){ - pDb->interp = interp; - sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb); - }else{ - sqlite3_progress_handler(pDb->db, 0, 0, 0); - } -#endif - }else{ - Jim_WrongNumArgs(interp, 2, objv, "N CALLBACK"); - return JIM_ERR; - } - break; - } - - /* $db profile ?CALLBACK? - ** - ** Make arrangements to invoke the CALLBACK routine after each SQL statement - ** that has run. The text of the SQL and the amount of elapse time are - ** appended to CALLBACK before the script is run. - */ - case DB_PROFILE: { - if( objc>3 ){ - Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); - return JIM_ERR; - }else if( objc==2 ){ - if( pDb->zProfile ){ - Jim_SetResultString(interp, pDb->zProfile, -1); - } - }else{ - const char *zProfile; - int len; - if( pDb->zProfile ){ - Jim_Free(pDb->zProfile); - } - zProfile = Jim_GetString(objv[2], &len); - if( zProfile && len>0 ){ - pDb->zProfile = Jim_Alloc( len + 1 ); - memcpy(pDb->zProfile, zProfile, len+1); - }else{ - pDb->zProfile = 0; - } -#ifndef SQLITE_OMIT_TRACE - if( pDb->zProfile ){ - pDb->interp = interp; - sqlite3_profile(pDb->db, DbProfileHandler, pDb); - }else{ - sqlite3_profile(pDb->db, 0, 0); - } -#endif - } - break; - } - - /* - ** $db rekey KEY - ** - ** Change the encryption key on the currently open database. - */ - case DB_REKEY: { - int nKey; - const char *pKey; - if( objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "KEY"); - return JIM_ERR; - } - //pKey = Jim_GetByteArrayFromObj(objv[2], &nKey); - pKey = Jim_GetString(objv[2], &nKey); -#ifdef SQLITE_HAS_CODEC - rc = sqlite3_rekey(pDb->db, pKey, nKey); - if( rc ){ - Jim_SetResultString(interp, sqlite3ErrStr(rc), -1); - rc = JIM_ERR; - } -#endif - break; - } - - /* $db restore ?DATABASE? FILENAME - ** - ** Open a database file named FILENAME. Transfer the content - ** of FILENAME into the local database DATABASE (default: "main"). - */ - case DB_RESTORE: { - const char *zSrcFile; - const char *zDestDb; - sqlite3 *pSrc; - sqlite3_backup *pBackup; - int nTimeout = 0; - - if( objc==3 ){ - zDestDb = "main"; - zSrcFile = Jim_String(objv[2]); - }else if( objc==4 ){ - zDestDb = Jim_String(objv[2]); - zSrcFile = Jim_String(objv[3]); - }else{ - Jim_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); - return JIM_ERR; - } - rc = sqlite3_open_v2(zSrcFile, &pSrc, SQLITE_OPEN_READONLY, 0); - if( rc!=SQLITE_OK ){ - Jim_SetResultFormatted(interp, "cannot open source database: %s", sqlite3_errmsg(pSrc)); - sqlite3_close(pSrc); - return JIM_ERR; - } - pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main"); - if( pBackup==0 ){ - Jim_SetResultFormatted(interp, "restore failed: %s", sqlite3_errmsg(pDb->db)); - sqlite3_close(pSrc); - return JIM_ERR; - } - while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK - || rc==SQLITE_BUSY ){ - if( rc==SQLITE_BUSY ){ - if( nTimeout++ >= 3 ) break; - sqlite3_sleep(100); - } - } - sqlite3_backup_finish(pBackup); - if( rc==SQLITE_DONE ){ - rc = JIM_OK; - }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){ - Jim_SetResultString(interp, "restore failed: source database busy", -1); - rc = JIM_ERR; - }else{ - Jim_SetResultFormatted(interp, "restore failed: %s", sqlite3_errmsg(pDb->db)); - rc = JIM_ERR; - } - sqlite3_close(pSrc); - break; - } - - /* - ** $db status (step|sort) - ** - ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or - ** SQLITE_STMTSTATUS_SORT for the most recent eval. - */ - case DB_STATUS: { - int v; - const char *zOp; - if( objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "(step|sort)"); - return JIM_ERR; - } - zOp = Jim_String(objv[2]); - if( strcmp(zOp, "step")==0 ){ - v = pDb->nStep; - }else if( strcmp(zOp, "sort")==0 ){ - v = pDb->nSort; - }else{ - Jim_SetResultString(interp, "bad argument: should be step or sort", -1); - return JIM_ERR; - } - Jim_SetResultInt(interp, v); - break; - } - - /* - ** $db timeout MILLESECONDS - ** - ** Delay for the number of milliseconds specified when a file is locked. - */ - case DB_TIMEOUT: { - long ms; - if( objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "MILLISECONDS"); - return JIM_ERR; - } - if( Jim_GetLong(interp, objv[2], &ms) ) return JIM_ERR; - sqlite3_busy_timeout(pDb->db, ms); - break; - } - - /* - ** $db total_changes - ** - ** Return the number of rows that were modified, inserted, or deleted - ** since the database handle was created. - */ - case DB_TOTAL_CHANGES: { - if( objc!=2 ){ - Jim_WrongNumArgs(interp, 2, objv, ""); - return JIM_ERR; - } - Jim_SetResultInt(interp, sqlite3_total_changes(pDb->db)); - break; - } - - /* $db trace ?CALLBACK? - ** - ** Make arrangements to invoke the CALLBACK routine for each SQL statement - ** that is executed. The text of the SQL is appended to CALLBACK before - ** it is executed. - */ - case DB_TRACE: { - if( objc>3 ){ - Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); - return JIM_ERR; - }else if( objc==2 ){ - if( pDb->zTrace ){ - Jim_AppendString(interp, Jim_GetResult(interp), pDb->zTrace, -1); - } - }else{ - const char *zTrace; - int len; - if( pDb->zTrace ){ - Jim_Free(pDb->zTrace); - } - zTrace = Jim_GetString(objv[2], &len); - if( zTrace && len>0 ){ - pDb->zTrace = Jim_Alloc( len + 1 ); - memcpy(pDb->zTrace, zTrace, len+1); - }else{ - pDb->zTrace = 0; - } -#ifndef SQLITE_OMIT_TRACE - if( pDb->zTrace ){ - pDb->interp = interp; - sqlite3_trace(pDb->db, DbTraceHandler, pDb); - }else{ - sqlite3_trace(pDb->db, 0, 0); - } -#endif - } - break; - } - - /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT - ** - ** Start a new transaction (if we are not already in the midst of a - ** transaction) and execute the TCL script SCRIPT. After SCRIPT - ** completes, either commit the transaction or roll it back if SCRIPT - ** throws an exception. Or if no new transation was started, do nothing. - ** pass the exception on up the stack. - ** - ** This command was inspired by Dave Thomas's talk on Ruby at the - ** 2005 O'Reilly Open Source Convention (OSCON). - */ - case DB_TRANSACTION: { - Jim_Obj *pScript; - const char *zBegin = "SAVEPOINT _tcl_transaction"; - if( objc!=3 && objc!=4 ){ - Jim_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT"); - return JIM_ERR; - } - - if( pDb->nTransaction==0 && objc==4 ){ - static const char *TTYPE_strs[] = { - "deferred", "exclusive", "immediate", 0 - }; - enum TTYPE_enum { - TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE - }; - int ttype; - if( Jim_GetEnum(interp, objv[2], TTYPE_strs, &ttype, "transaction type", JIM_ERRMSG | JIM_ENUM_ABBREV) ){ - return JIM_ERR; - } - switch( (enum TTYPE_enum)ttype ){ - case TTYPE_DEFERRED: /* no-op */; break; - case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break; - case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break; - } - } - pScript = objv[objc-1]; - - /* Run the SQLite BEGIN command to open a transaction or savepoint. */ - pDb->disableAuth++; - rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0); - pDb->disableAuth--; - if( rc!=SQLITE_OK ){ - Jim_SetResultString(interp, sqlite3_errmsg(pDb->db), -1); - return JIM_ERR; - } - pDb->nTransaction++; - - /* No NRE in Jim Tcl, so evaluate the script directly, then - ** call function DbTransPostCmd() to commit (or rollback) the transaction - ** or savepoint. */ - rc = DbTransPostCmd(interp, pDb, Jim_EvalObj(interp, pScript)); - break; - } - - /* - ** $db unlock_notify ?script? - */ - case DB_UNLOCK_NOTIFY: { -#ifndef SQLITE_ENABLE_UNLOCK_NOTIFY - Jim_SetResultString(interp, "unlock_notify not available in this build", -1); - rc = JIM_ERR; -#else - if( objc!=2 && objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); - rc = JIM_ERR; - }else{ - void (*xNotify)(void **, int) = 0; - void *pNotifyArg = 0; - - if( pDb->pUnlockNotify ){ - Jim_DecrRefCount(interp, pDb->pUnlockNotify); - pDb->pUnlockNotify = 0; - } - - if( objc==3 ){ - xNotify = DbUnlockNotify; - pNotifyArg = (void *)pDb; - pDb->pUnlockNotify = objv[2]; - Jim_IncrRefCount(pDb->pUnlockNotify); - } - - if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){ - Jim_SetResultString(interp, sqlite3_errmsg(pDb->db), -1); - rc = JIM_ERR; - } - } -#endif - break; - } - - /* - ** $db update_hook ?script? - ** $db rollback_hook ?script? - */ - case DB_UPDATE_HOOK: - case DB_ROLLBACK_HOOK: { - - /* set ppHook to point at pUpdateHook or pRollbackHook, depending on - ** whether [$db update_hook] or [$db rollback_hook] was invoked. - */ - Jim_Obj **ppHook; - if( choice==DB_UPDATE_HOOK ){ - ppHook = &pDb->pUpdateHook; - }else{ - ppHook = &pDb->pRollbackHook; - } - - if( objc!=2 && objc!=3 ){ - Jim_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); - return JIM_ERR; - } - if( *ppHook ){ - Jim_SetResult(interp, *ppHook); - if( objc==3 ){ - Jim_DecrRefCount(interp, *ppHook); - *ppHook = 0; - } - } - if( objc==3 ){ - assert( !(*ppHook) ); - if( Jim_Length(objv[2])>0 ){ - *ppHook = objv[2]; - Jim_IncrRefCount(*ppHook); - } - } - - sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb); - sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb); - - break; - } - - /* $db version - ** - ** Return the version string for this database. - */ - case DB_VERSION: { - Jim_SetResultString(interp, sqlite3_libversion(), -1); - break; - } - - - } /* End of the SWITCH statement */ - return rc; -} - -/* -** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN? -** ?-create BOOLEAN? ?-nomutex BOOLEAN? -** -** This is the main Tcl command. When the "sqlite" Tcl command is -** invoked, this routine runs to process that command. -** -** The first argument, DBNAME, is an arbitrary name for a new -** database connection. This command creates a new command named -** DBNAME that is used to control that connection. The database -** connection is deleted when the DBNAME command is deleted. -** -** The second argument is the name of the database file. -** -*/ -static int DbMain(Jim_Interp *interp, int objc, Jim_Obj *const*objv){ - SqliteDb *p; - const char *pKey = 0; - int nKey = 0; - const char *zArg; - char *zErrMsg; - int i; - const char *zFile; - const char *zVfs = 0; - int flags; - - /* Not threading in Jim, so no mutexing is needed */ - flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX; - - if( objc==2 ){ - zArg = Jim_String(objv[1]); - if( strcmp(zArg,"-version")==0 ){ - Jim_SetResultString(interp, sqlite3_version, -1); - return JIM_OK; - } - if( strcmp(zArg,"-has-codec")==0 ){ -#ifdef SQLITE_HAS_CODEC - Jim_SetResultInt(interp, 1); -#else - Jim_SetResultInt(interp, 0); -#endif - return JIM_OK; - } - } - for(i=3; i+1db, flags, zVfs); - if( SQLITE_OK!=sqlite3_errcode(p->db) ){ - zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); - sqlite3_close(p->db); - p->db = 0; - } -#ifdef SQLITE_HAS_CODEC - if( p->db ){ - sqlite3_key(p->db, pKey, nKey); - } -#endif - if( p->db==0 ){ - Jim_SetResultString(interp, zErrMsg, -1); - Jim_Free((char*)p); - sqlite3_free(zErrMsg); - return JIM_ERR; - } - p->maxStmt = NUM_PREPARED_STMTS; - p->interp = interp; - zArg = Jim_String(objv[1]); - Jim_CreateCommand(interp, zArg, DbObjCmd, p, DbDeleteCmd); - return JIM_OK; -} - -/* -** Make sure we have a PACKAGE_VERSION macro defined. This will be -** defined automatically by the TEA makefile. But other makefiles -** do not define it. -*/ -#ifndef PACKAGE_VERSION -# define PACKAGE_VERSION SQLITE_VERSION -#endif - -#define EXTERN -/* -** Initialize this module. -** -** This Tcl module contains only a single new Tcl command named "sqlite". -** (Hence there is no namespace. There is no point in using a namespace -** if the extension only supplies one new name!) The "sqlite" command is -** used to open a new SQLite database. See the DbMain() routine above -** for additional information. -*/ -EXTERN int Jim_sqlite3Init(Jim_Interp *interp){ - Jim_CreateCommand(interp, "sqlite3", DbMain, 0, 0); - Jim_PackageProvide(interp, "sqlite3", PACKAGE_VERSION, 0); - Jim_CreateCommand(interp, "sqlite", DbMain, 0, 0); - Jim_PackageProvide(interp, "sqlite", PACKAGE_VERSION, 0); - return JIM_OK; -} diff -Nru jimtcl-0.79+dfsg0/sqlite3/jim-sqlite.c jimtcl-0.81+dfsg0/sqlite3/jim-sqlite.c --- jimtcl-0.79+dfsg0/sqlite3/jim-sqlite.c 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/sqlite3/jim-sqlite.c 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,2828 @@ +/* Jim Tcl version of the sqlite3 Tcl binding. + * From sqlite3 3.6.22 + * + * This version is (c) Steve Bennett + * Copyright of the original version is below. + */ + +/* +** 2001 September 15 +** +** The author disclaims copyright to this source code. In place of +** a legal notice, here is a blessing: +** +** May you do good and not evil. +** May you find forgiveness for yourself and forgive others. +** May you share freely, never taking more than you give. +** +************************************************************************* +** A TCL Interface to SQLite. Append this file to sqlite3.c and +** compile the whole thing to build a TCL-enabled version of SQLite. +** +** Compile-time options: +** +** -D SQLITE_TEST When used in conjuction with -DTCLSH=1, add +** hundreds of new commands used for testing +** SQLite. This option implies -DSQLITE_TCLMD5. +*/ +#include +#include +#include +#include + +/* +** Some additional include files are needed if this file is not +** appended to the amalgamation. +*/ +#ifndef SQLITE_AMALGAMATION +# include "sqlite3.h" +# include +# include +# include + typedef unsigned char u8; +#endif +#include + +#define NUM_PREPARED_STMTS 10 +#define MAX_PREPARED_STMTS 100 + +/* +** If Jim Tcl uses UTF-8 and SQLite is configured to use iso8859, then we +#ifdef JIM_UTF8 +#define SQLITE_UTF8 +#endif + +** have to do a translation when going between the two. Set the +** UTF_TRANSLATION_NEEDED macro to indicate that we need to do +** this translation. +*/ +#if defined(JIM_UTF8) && !defined(SQLITE_UTF8) +# define UTF_TRANSLATION_NEEDED 1 +# warning Jim Tcl can not translate encoding from iso8859 to utf-8 +#endif + +/* +** New SQL functions can be created as TCL scripts. Each such function +** is described by an instance of the following structure. +*/ +typedef struct SqlFunc SqlFunc; +struct SqlFunc { + Jim_Interp *interp; /* The TCL interpret to execute the function */ + Jim_Obj *pScript; /* The Jim_Obj representation of the script */ + int useEvalObjv; /* True if it is safe to use Jim_EvalObjv */ + char *zName; /* Name of this function */ + SqlFunc *pNext; /* Next function on the list of them all */ +}; + +/* +** New collation sequences function can be created as TCL scripts. Each such +** function is described by an instance of the following structure. +*/ +typedef struct SqlCollate SqlCollate; +struct SqlCollate { + Jim_Interp *interp; /* The TCL interpret to execute the function */ + char *zScript; /* The script to be run */ + SqlCollate *pNext; /* Next function on the list of them all */ +}; + +/* +** Prepared statements are cached for faster execution. Each prepared +** statement is described by an instance of the following structure. +*/ +typedef struct SqlPreparedStmt SqlPreparedStmt; +struct SqlPreparedStmt { + SqlPreparedStmt *pNext; /* Next in linked list */ + SqlPreparedStmt *pPrev; /* Previous on the list */ + sqlite3_stmt *pStmt; /* The prepared statement */ + int nSql; /* chars in zSql[] */ + const char *zSql; /* Text of the SQL statement */ + int nParm; /* Size of apParm array */ + Jim_Obj **apParm; /* Array of referenced object pointers */ +}; + +typedef struct IncrblobChannel IncrblobChannel; + +/* +** There is one instance of this structure for each SQLite database +** that has been opened by the SQLite TCL interface. +*/ +typedef struct SqliteDb SqliteDb; +struct SqliteDb { + sqlite3 *db; /* The "real" database structure. MUST BE FIRST */ + Jim_Interp *interp; /* The interpreter used for this database */ + char *zBusy; /* The busy callback routine */ + char *zCommit; /* The commit hook callback routine */ + char *zTrace; /* The trace callback routine */ + char *zProfile; /* The profile callback routine */ + char *zProgress; /* The progress callback routine */ + char *zAuth; /* The authorization callback routine */ + int disableAuth; /* Disable the authorizer if it exists */ + char *zNull; /* Text to substitute for an SQL NULL value */ + SqlFunc *pFunc; /* List of SQL functions */ + Jim_Obj *pUpdateHook; /* Update hook script (if any) */ + Jim_Obj *pRollbackHook; /* Rollback hook script (if any) */ + Jim_Obj *pUnlockNotify; /* Unlock notify script (if any) */ + SqlCollate *pCollate; /* List of SQL collation functions */ + int rc; /* Return code of most recent sqlite3_exec() */ + Jim_Obj *pCollateNeeded; /* Collation needed script */ + SqlPreparedStmt *stmtList; /* List of prepared statements*/ + SqlPreparedStmt *stmtLast; /* Last statement in the list */ + int maxStmt; /* The next maximum number of stmtList */ + int nStmt; /* Number of statements in stmtList */ + IncrblobChannel *pIncrblob;/* Linked list of open incrblob channels */ + int nStep, nSort; /* Statistics for most recent operation */ + int nTransaction; /* Number of nested [transaction] methods */ +}; + +struct IncrblobChannel { + sqlite3_blob *pBlob; /* sqlite3 blob handle */ + SqliteDb *pDb; /* Associated database connection */ + int iSeek; /* Current seek offset */ + Jim_Obj *channel; /* Channel identifier */ + IncrblobChannel *pNext; /* Linked list of all open incrblob channels */ + IncrblobChannel *pPrev; /* Linked list of all open incrblob channels */ +}; + +/* +** Compute a string length that is limited to what can be stored in +** lower 30 bits of a 32-bit signed integer. +*/ +static int strlen30(const char *z){ + const char *z2 = z; + while( *z2 ){ z2++; } + return 0x3fffffff & (int)(z2 - z); +} + + +#ifndef SQLITE_OMIT_INCRBLOB +/* +** Close all incrblob channels opened using database connection pDb. +** This is called when shutting down the database connection. +*/ +static void closeIncrblobChannels(SqliteDb *pDb){ + IncrblobChannel *p; + IncrblobChannel *pNext; + + for(p=pDb->pIncrblob; p; p=pNext){ + pNext = p->pNext; + + /* Note: Calling unregister here call Jim_Close on the incrblob channel, + ** which deletes the IncrblobChannel structure at *p. So do not + ** call Jim_Free() here. + */ + Jim_UnregisterChannel(pDb->interp, p->channel); + } +} + +/* +** Close an incremental blob channel. +*/ +static int incrblobClose(ClientData instanceData, Jim_Interp *interp){ + IncrblobChannel *p = (IncrblobChannel *)instanceData; + int rc = sqlite3_blob_close(p->pBlob); + sqlite3 *db = p->pDb->db; + + /* Remove the channel from the SqliteDb.pIncrblob list. */ + if( p->pNext ){ + p->pNext->pPrev = p->pPrev; + } + if( p->pPrev ){ + p->pPrev->pNext = p->pNext; + } + if( p->pDb->pIncrblob==p ){ + p->pDb->pIncrblob = p->pNext; + } + + /* Free the IncrblobChannel structure */ + Jim_Free((char *)p); + + if( rc!=SQLITE_OK ){ + Jim_SetResult(interp, (char *)sqlite3_errmsg(db), JIM_VOLATILE); + return JIM_ERR; + } + return JIM_OK; +} + +/* +** Read data from an incremental blob channel. +*/ +static int incrblobInput( + ClientData instanceData, + char *buf, + int bufSize, + int *errorCodePtr +){ + IncrblobChannel *p = (IncrblobChannel *)instanceData; + int nRead = bufSize; /* Number of bytes to read */ + int nBlob; /* Total size of the blob */ + int rc; /* sqlite error code */ + + nBlob = sqlite3_blob_bytes(p->pBlob); + if( (p->iSeek+nRead)>nBlob ){ + nRead = nBlob-p->iSeek; + } + if( nRead<=0 ){ + return 0; + } + + rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek); + if( rc!=SQLITE_OK ){ + *errorCodePtr = rc; + return -1; + } + + p->iSeek += nRead; + return nRead; +} + +/* +** Write data to an incremental blob channel. +*/ +static int incrblobOutput( + ClientData instanceData, + CONST char *buf, + int toWrite, + int *errorCodePtr +){ + IncrblobChannel *p = (IncrblobChannel *)instanceData; + int nWrite = toWrite; /* Number of bytes to write */ + int nBlob; /* Total size of the blob */ + int rc; /* sqlite error code */ + + nBlob = sqlite3_blob_bytes(p->pBlob); + if( (p->iSeek+nWrite)>nBlob ){ + *errorCodePtr = EINVAL; + return -1; + } + if( nWrite<=0 ){ + return 0; + } + + rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek); + if( rc!=SQLITE_OK ){ + *errorCodePtr = EIO; + return -1; + } + + p->iSeek += nWrite; + return nWrite; +} + +/* +** Seek an incremental blob channel. +*/ +static int incrblobSeek( + ClientData instanceData, + long offset, + int seekMode, + int *errorCodePtr +){ + IncrblobChannel *p = (IncrblobChannel *)instanceData; + + switch( seekMode ){ + case SEEK_SET: + p->iSeek = offset; + break; + case SEEK_CUR: + p->iSeek += offset; + break; + case SEEK_END: + p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset; + break; + + default: assert(!"Bad seekMode"); + } + + return p->iSeek; +} + + +static void incrblobWatch(ClientData instanceData, int mode){ + /* NO-OP */ +} +static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){ + return JIM_ERR; +} + +static Jim_ChannelType IncrblobChannelType = { + "incrblob", /* typeName */ + JIM_CHANNEL_VERSION_2, /* version */ + incrblobClose, /* closeProc */ + incrblobInput, /* inputProc */ + incrblobOutput, /* outputProc */ + incrblobSeek, /* seekProc */ + 0, /* setOptionProc */ + 0, /* getOptionProc */ + incrblobWatch, /* watchProc (this is a no-op) */ + incrblobHandle, /* getHandleProc (always returns error) */ + 0, /* close2Proc */ + 0, /* blockModeProc */ + 0, /* flushProc */ + 0, /* handlerProc */ + 0, /* wideSeekProc */ +}; + +/* +** Create a new incrblob channel. +*/ +static int createIncrblobChannel( + Jim_Interp *interp, + SqliteDb *pDb, + const char *zDb, + const char *zTable, + const char *zColumn, + sqlite_int64 iRow, + int isReadonly +){ + IncrblobChannel *p; + sqlite3 *db = pDb->db; + sqlite3_blob *pBlob; + int rc; + int flags = JIM_READABLE|(isReadonly ? 0 : JIM_WRITABLE); + + /* This variable is used to name the channels: "incrblob_[incr count]" */ + static int count = 0; + char zChannel[64]; + + rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob); + if( rc!=SQLITE_OK ){ + Jim_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), JIM_VOLATILE); + return JIM_ERR; + } + + p = (IncrblobChannel *)Jim_Alloc(sizeof(IncrblobChannel)); + p->iSeek = 0; + p->pBlob = pBlob; + + sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count); + p->channel = Jim_CreateChannel(&IncrblobChannelType, zChannel, p, flags); + Jim_RegisterChannel(interp, p->channel); + + /* Link the new channel into the SqliteDb.pIncrblob list. */ + p->pNext = pDb->pIncrblob; + p->pPrev = 0; + if( p->pNext ){ + p->pNext->pPrev = p; + } + pDb->pIncrblob = p; + p->pDb = pDb; + + Jim_SetResult(interp, (char *)Jim_GetChannelName(p->channel), JIM_VOLATILE); + return JIM_OK; +} +#else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */ + #define closeIncrblobChannels(pDb) +#endif + +/* +** Look at the script prefix in pCmd. We will be executing this script +** after first appending one or more arguments. This routine analyzes +** the script to see if it is safe to use Jim_EvalObjv() on the script +** rather than the more general Jim_EvalEx(). Jim_EvalObjv() is much +** faster. +** +** Scripts that are safe to use with Jim_EvalObjv() consists of a +** command name followed by zero or more arguments with no [...] or $ +** or {...} or ; to be seen anywhere. Most callback scripts consist +** of just a single procedure name and they meet this requirement. +*/ +static int safeToUseEvalObjv(Jim_Interp *interp, Jim_Obj *pCmd){ + /* We could try to do something with Jim_Parse(). But we will instead + ** just do a search for forbidden characters. If any of the forbidden + ** characters appear in pCmd, we will report the string as unsafe. + */ + const char *z; + int n; + z = Jim_GetString(pCmd, &n); + while( n-- > 0 ){ + int c = *(z++); + if( c=='$' || c=='[' || c==';' ) return 0; + } + return 1; +} + +/* +** Find an SqlFunc structure with the given name. Or create a new +** one if an existing one cannot be found. Return a pointer to the +** structure. +*/ +static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){ + SqlFunc *p, *pNew; + int i; + pNew = (SqlFunc*)Jim_Alloc( sizeof(*pNew) + strlen30(zName) + 1 ); + pNew->zName = (char*)&pNew[1]; + for(i=0; zName[i]; i++){ pNew->zName[i] = tolower((unsigned)zName[i]); } + pNew->zName[i] = 0; + for(p=pDb->pFunc; p; p=p->pNext){ + if( strcmp(p->zName, pNew->zName)==0 ){ + Jim_Free((char*)pNew); + return p; + } + } + pNew->interp = pDb->interp; + pNew->pScript = 0; + pNew->pNext = pDb->pFunc; + pDb->pFunc = pNew; + return pNew; +} + +/* +** Finalize and free a list of prepared statements +*/ +static void flushStmtCache( SqliteDb *pDb ){ + SqlPreparedStmt *pPreStmt; + + while( pDb->stmtList ){ + sqlite3_finalize( pDb->stmtList->pStmt ); + pPreStmt = pDb->stmtList; + pDb->stmtList = pDb->stmtList->pNext; + Jim_Free( (char*)pPreStmt ); + } + pDb->nStmt = 0; + pDb->stmtLast = 0; +} + +/* +** TCL calls this procedure when an sqlite3 database command is +** deleted. +*/ +static void DbDeleteCmd(Jim_Interp *interp, void *db){ + SqliteDb *pDb = (SqliteDb*)db; + flushStmtCache(pDb); + closeIncrblobChannels(pDb); + sqlite3_close(pDb->db); + while( pDb->pFunc ){ + SqlFunc *pFunc = pDb->pFunc; + pDb->pFunc = pFunc->pNext; + Jim_DecrRefCount(interp, pFunc->pScript); + Jim_Free((char*)pFunc); + } + while( pDb->pCollate ){ + SqlCollate *pCollate = pDb->pCollate; + pDb->pCollate = pCollate->pNext; + Jim_Free((char*)pCollate); + } + if( pDb->zBusy ){ + Jim_Free(pDb->zBusy); + } + if( pDb->zTrace ){ + Jim_Free(pDb->zTrace); + } + if( pDb->zProfile ){ + Jim_Free(pDb->zProfile); + } + if( pDb->zAuth ){ + Jim_Free(pDb->zAuth); + } + if( pDb->zNull ){ + Jim_Free(pDb->zNull); + } + if( pDb->pUpdateHook ){ + Jim_DecrRefCount(interp, pDb->pUpdateHook); + } + if( pDb->pRollbackHook ){ + Jim_DecrRefCount(interp, pDb->pRollbackHook); + } + if( pDb->pCollateNeeded ){ + Jim_DecrRefCount(interp, pDb->pCollateNeeded); + } + Jim_Free((char*)pDb); +} + +/* +** This routine is called when a database file is locked while trying +** to execute SQL. +*/ +static int DbBusyHandler(void *cd, int nTries){ + SqliteDb *pDb = (SqliteDb*)cd; + int rc; + char zVal[30]; + Jim_Obj *objPtr; + + sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries); + + objPtr = Jim_NewStringObj(pDb->interp, pDb->zBusy, -1); + Jim_AppendStrings(pDb->interp, objPtr, " ", zVal, NULL); + rc = Jim_EvalObj(pDb->interp, objPtr); + if( rc!=JIM_OK || atoi(Jim_String(Jim_GetResult(pDb->interp))) ){ + return 0; + } + return 1; +} + +#ifndef SQLITE_OMIT_PROGRESS_CALLBACK +/* +** This routine is invoked as the 'progress callback' for the database. +*/ +static int DbProgressHandler(void *cd){ + SqliteDb *pDb = (SqliteDb*)cd; + int rc; + + assert( pDb->zProgress ); + rc = Jim_Eval(pDb->interp, pDb->zProgress); + if( rc!=JIM_OK || atoi(Jim_String(Jim_GetResult(pDb->interp))) ){ + return 1; + } + return 0; +} +#endif + +#ifndef SQLITE_OMIT_TRACE +/* +** This routine is called by the SQLite trace handler whenever a new +** block of SQL is executed. The TCL script in pDb->zTrace is executed. +*/ +static void DbTraceHandler(void *cd, const char *zSql){ + SqliteDb *pDb = (SqliteDb*)cd; + + Jim_Obj *str = Jim_NewStringObj(pDb->interp, pDb->zTrace, -1); + Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zSql, -1)); + Jim_Eval(pDb->interp, zSql); + Jim_SetEmptyResult(pDb->interp); +} +#endif + +#ifndef SQLITE_OMIT_TRACE +/* +** This routine is called by the SQLite profile handler after a statement +** SQL has executed. The TCL script in pDb->zProfile is evaluated. +*/ +static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){ + SqliteDb *pDb = (SqliteDb*)cd; + Jim_Obj *str; + char zTm[100]; + + sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm); + str = Jim_NewStringObj(pDb->interp, pDb->zProfile, -1); + Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zSql, -1)); + Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zTm, -1)); + Jim_EvalObj(pDb->interp, str); + Jim_SetEmptyResult(pDb->interp); +} +#endif + +/* +** This routine is called when a transaction is committed. The +** TCL script in pDb->zCommit is executed. If it returns non-zero or +** if it throws an exception, the transaction is rolled back instead +** of being committed. +*/ +static int DbCommitHandler(void *cd){ + SqliteDb *pDb = (SqliteDb*)cd; + int rc; + + rc = Jim_Eval(pDb->interp, pDb->zCommit); + if( rc!=JIM_OK || atoi(Jim_String(Jim_GetResult(pDb->interp))) ){ + return 1; + } + return 0; +} + +static void DbRollbackHandler(void *clientData){ + SqliteDb *pDb = (SqliteDb*)clientData; + assert(pDb->pRollbackHook); + Jim_EvalObjBackground(pDb->interp, pDb->pRollbackHook); +} + +#if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY) +static void setTestUnlockNotifyVars(Jim_Interp *interp, int iArg, int nArg){ + char zBuf[64]; + sprintf(zBuf, "%d", iArg); + Jim_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, JIM_GLOBAL_ONLY); + sprintf(zBuf, "%d", nArg); + Jim_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, JIM_GLOBAL_ONLY); +} +#else +# define setTestUnlockNotifyVars(x,y,z) +#endif + +#ifdef SQLITE_ENABLE_UNLOCK_NOTIFY +static void DbUnlockNotify(void **apArg, int nArg){ + int i; + for(i=0; iinterp, i, nArg); + assert( pDb->pUnlockNotify); + Jim_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags); + Jim_DecrRefCount(interp, pDb->pUnlockNotify); + pDb->pUnlockNotify = 0; + } +} +#endif + +static void DbUpdateHandler( + void *p, + int op, + const char *zDb, + const char *zTbl, + sqlite_int64 rowid +){ + SqliteDb *pDb = (SqliteDb *)p; + Jim_Obj *pCmd; + + assert( pDb->pUpdateHook ); + assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE ); + + pCmd = Jim_DuplicateObj(pDb->interp, pDb->pUpdateHook); + Jim_IncrRefCount(pCmd); + Jim_ListAppendElement(0, pCmd, Jim_NewStringObj(pDb->interp, + ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1)); + Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewStringObj(pDb->interp, zDb, -1)); + Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewStringObj(pDb->interp, zTbl, -1)); + Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewIntObj(pDb->interp, rowid)); + Jim_EvalObj(pDb->interp, pCmd); +} + +static void tclCollateNeeded( + void *pCtx, + sqlite3 *db, + int enc, + const char *zName +){ + SqliteDb *pDb = (SqliteDb *)pCtx; + Jim_Obj *pScript = Jim_DuplicateObj(pDb->interp, pDb->pCollateNeeded); + //Jim_IncrRefCount(pScript); + Jim_ListAppendElement(pDb->interp, pScript, Jim_NewStringObj(pDb->interp, zName, -1)); + Jim_EvalObj(pDb->interp, pScript); + //Jim_DecrRefCount(pDb->interp, pScript); +} + +/* +** This routine is called to evaluate an SQL collation function implemented +** using TCL script. +*/ +static int tclSqlCollate( + void *pCtx, + int nA, + const void *zA, + int nB, + const void *zB +){ + SqlCollate *p = (SqlCollate *)pCtx; + Jim_Obj *pCmd; + + pCmd = Jim_NewStringObj(p->interp, p->zScript, -1); + //Jim_IncrRefCount(pCmd); + Jim_ListAppendElement(p->interp, pCmd, Jim_NewStringObj(p->interp, zA, nA)); + Jim_ListAppendElement(p->interp, pCmd, Jim_NewStringObj(p->interp, zB, nB)); + Jim_EvalObj(p->interp, pCmd); + //Jim_DecrRefCount(interp, pCmd); + return (atoi(Jim_String(Jim_GetResult(p->interp)))); +} + +/* +** This routine is called to evaluate an SQL function implemented +** using TCL script. +*/ +static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ + SqlFunc *p = sqlite3_user_data(context); + Jim_Obj *pCmd; + int i; + int rc; + + if( argc==0 ){ + /* If there are no arguments to the function, call Jim_EvalObjEx on the + ** script object directly. This allows the TCL compiler to generate + ** bytecode for the command on the first invocation and thus make + ** subsequent invocations much faster. */ + pCmd = p->pScript; + //Jim_IncrRefCount(pCmd); + rc = Jim_EvalObj(p->interp, pCmd); + //Jim_DecrRefCount(interp, pCmd); + }else{ + /* If there are arguments to the function, make a shallow copy of the + ** script object, lappend the arguments, then evaluate the copy. + ** + ** By "shallow" copy, we mean a only the outer list Jim_Obj is duplicated. + ** The new Jim_Obj contains pointers to the original list elements. + ** That way, when Jim_EvalObjv() is run and shimmers the first element + ** of the list to tclCmdNameType, that alternate representation will + ** be preserved and reused on the next invocation. + */ + pCmd = Jim_DuplicateObj(p->interp, p->pScript); + Jim_IncrRefCount(pCmd); + for(i=0; iinterp, sqlite3_value_blob(pIn), bytes); + break; + } + case SQLITE_INTEGER: { + sqlite_int64 v = sqlite3_value_int64(pIn); + pVal = Jim_NewIntObj(p->interp, v); + break; + } + case SQLITE_FLOAT: { + double r = sqlite3_value_double(pIn); + pVal = Jim_NewDoubleObj(p->interp, r); + break; + } + case SQLITE_NULL: { + pVal = Jim_NewStringObj(p->interp, "", 0); + break; + } + default: { + int bytes = sqlite3_value_bytes(pIn); + pVal = Jim_NewStringObj(p->interp, (char *)sqlite3_value_text(pIn), bytes); + break; + } + } + Jim_ListAppendElement(p->interp, pCmd, pVal); + } + if( !p->useEvalObjv ){ + /* Jim_EvalOb() will automatically call Jim_EvalObjVector() if pCmd + ** is a list without a string representation. To prevent this from + ** happening, make sure pCmd has a valid string representation */ + Jim_String(pCmd); + } + rc = Jim_EvalObj(p->interp, pCmd); + Jim_DecrRefCount(p->interp, pCmd); + } + + if( rc && rc!=JIM_RETURN ){ + sqlite3_result_error(context, Jim_String(Jim_GetResult(p->interp)), -1); + }else{ + Jim_Obj *pVar = Jim_GetResult(p->interp); + int n; + u8 *data; + /* XXX: Jim Tcl doesn't have bytearray or boolean */ + const char *zType = (pVar->typePtr ? pVar->typePtr->name : ""); + char c = zType[0]; +#if 0 + if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ + /* Only return a BLOB type if the Tcl variable is a bytearray and + ** has no string representation. */ + data = Jim_GetByteArrayFromObj(pVar, &n); + sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT); + }else if( c=='b' && strcmp(zType,"boolean")==0 ){ + Jim_GetWide(0, pVar, &n); + sqlite3_result_int(context, n); + }else +#endif + if( c=='d' && strcmp(zType,"double")==0 ){ + double r; + Jim_GetDouble(0, pVar, &r); + sqlite3_result_double(context, r); + /* XXX: Is a cooerced double better as a double or an int? */ + }else if( (c=='c' && strcmp(zType,"coerced-double")==0) || + (c=='i' && strcmp(zType,"int")==0) ){ + jim_wide v; + Jim_GetWide(p->interp, pVar, &v); + sqlite3_result_int64(context, v); + }else{ + data = (unsigned char *)Jim_GetString(pVar, &n); + sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); + } + } +} + +#ifndef SQLITE_OMIT_AUTHORIZATION +/* +** This is the authentication function. It appends the authentication +** type code and the two arguments to zCmd[] then invokes the result +** on the interpreter. The reply is examined to determine if the +** authentication fails or succeeds. +*/ +static int auth_callback( + void *pArg, + int code, + const char *zArg1, + const char *zArg2, + const char *zArg3, + const char *zArg4 +){ + char *zCode; + Jim_Obj *str; + int rc; + const char *zReply; + SqliteDb *pDb = (SqliteDb*)pArg; + if( pDb->disableAuth ) return SQLITE_OK; + + switch( code ){ + case SQLITE_COPY : zCode="SQLITE_COPY"; break; + case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break; + case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break; + case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break; + case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break; + case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break; + case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break; + case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break; + case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break; + case SQLITE_DELETE : zCode="SQLITE_DELETE"; break; + case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break; + case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break; + case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break; + case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break; + case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break; + case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break; + case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break; + case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break; + case SQLITE_INSERT : zCode="SQLITE_INSERT"; break; + case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break; + case SQLITE_READ : zCode="SQLITE_READ"; break; + case SQLITE_SELECT : zCode="SQLITE_SELECT"; break; + case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break; + case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break; + case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break; + case SQLITE_DETACH : zCode="SQLITE_DETACH"; break; + case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break; + case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break; + case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break; + case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break; + case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break; + case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break; + case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break; + default : zCode="????"; break; + } + str = Jim_NewStringObj(pDb->interp, pDb->zAuth, -1); + /* XXX: list or string here? */ + Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zCode, -1)); + if (zArg1) { + Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg1, -1)); + } + if (zArg2) { + Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg2, -1)); + } + if (zArg3) { + Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg3, -1)); + } + if (zArg4) { + Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg4, -1)); + } + Jim_IncrRefCount(str); + rc = Jim_EvalGlobal(pDb->interp, Jim_String(str)); + Jim_DecrRefCount(pDb->interp, str); + zReply = Jim_String(Jim_GetResult(pDb->interp)); + if( strcmp(zReply,"SQLITE_OK")==0 ){ + rc = SQLITE_OK; + }else if( strcmp(zReply,"SQLITE_DENY")==0 ){ + rc = SQLITE_DENY; + }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){ + rc = SQLITE_IGNORE; + }else{ + rc = 999; + } + return rc; +} +#endif /* SQLITE_OMIT_AUTHORIZATION */ + +/* +** Note that Jim Tcl can't do encoding conversion, +** so this simply returns the string as an object. +*/ +static Jim_Obj *dbTextToObj(Jim_Interp *interp, char const *zText){ + return Jim_NewStringObj(interp, zText ? zText : "", -1); +} + +/* +** This routine reads a line of text from FILE in, stores +** the text in memory obtained from malloc() and returns a pointer +** to the text. NULL is returned at end of file. +** +** The interface is like "readline" but no command-line editing +** is done. +** +** copied from shell.c from '.import' command +*/ +static char *local_getline(char *zPrompt, FILE *in){ + char *zLine; + int nLine; + int n; + int eol; + + nLine = 100; + zLine = Jim_Alloc( nLine ); + n = 0; + eol = 0; + while( !eol ){ + if( n+100>nLine ){ + nLine = nLine*2 + 100; + zLine = Jim_Realloc(zLine, nLine); + if( zLine==0 ) return 0; + } + if( fgets(&zLine[n], nLine - n, in)==0 ){ + if( n==0 ){ + Jim_Free(zLine); + return 0; + } + zLine[n] = 0; + eol = 1; + break; + } + while( zLine[n] ){ n++; } + if( n>0 && zLine[n-1]=='\n' ){ + n--; + zLine[n] = 0; + eol = 1; + } + } + zLine = Jim_Realloc( zLine, n+1 ); + return zLine; +} + + +/* +** This function is part of the implementation of the command: +** +** $db transaction [-deferred|-immediate|-exclusive] SCRIPT +** +** It is invoked after evaluating the script SCRIPT to commit or rollback +** the transaction or savepoint opened by the [transaction] command. +*/ +static int DbTransPostCmd( + Jim_Interp *interp, /* Tcl interpreter */ + SqliteDb *pDb, + int result /* Result of evaluating SCRIPT */ +){ + static const char *azEnd[] = { + "RELEASE _tcl_transaction", /* rc==JIM_ERR, nTransaction!=0 */ + "COMMIT", /* rc!=JIM_ERR, nTransaction==0 */ + "ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction", + "ROLLBACK" /* rc==JIM_ERR, nTransaction==0 */ + }; + int rc = result; + const char *zEnd; + + pDb->nTransaction--; + zEnd = azEnd[(rc==JIM_ERR)*2 + (pDb->nTransaction==0)]; + + pDb->disableAuth++; + if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){ + /* This is a tricky scenario to handle. The most likely cause of an + ** error is that the exec() above was an attempt to commit the + ** top-level transaction that returned SQLITE_BUSY. Or, less likely, + ** that an IO-error has occured. In either case, throw a Tcl exception + ** and try to rollback the transaction. + ** + ** But it could also be that the user executed one or more BEGIN, + ** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing + ** this method's logic. Not clear how this would be best handled. + */ + if( rc!=JIM_ERR ){ + Jim_AppendString(interp, Jim_GetResult(interp), sqlite3_errmsg(pDb->db), -1); + rc = JIM_ERR; + } + sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0); + } + pDb->disableAuth--; + + return rc; +} + +/* +** Search the cache for a prepared-statement object that implements the +** first SQL statement in the buffer pointed to by parameter zIn. If +** no such prepared-statement can be found, allocate and prepare a new +** one. In either case, bind the current values of the relevant Tcl +** variables to any $var, :var or @var variables in the statement. Before +** returning, set *ppPreStmt to point to the prepared-statement object. +** +** Output parameter *pzOut is set to point to the next SQL statement in +** buffer zIn, or to the '\0' byte at the end of zIn if there is no +** next statement. +** +** If successful, JIM_OK is returned. Otherwise, JIM_ERR is returned +** and an error message loaded into interpreter pDb->interp. +*/ +static int dbPrepareAndBind( + SqliteDb *pDb, /* Database object */ + char const *zIn, /* SQL to compile */ + char const **pzOut, /* OUT: Pointer to next SQL statement */ + SqlPreparedStmt **ppPreStmt /* OUT: Object used to cache statement */ +){ + const char *zSql = zIn; /* Pointer to first SQL statement in zIn */ + sqlite3_stmt *pStmt; /* Prepared statement object */ + SqlPreparedStmt *pPreStmt; /* Pointer to cached statement */ + int nSql; /* Length of zSql in bytes */ + int nVar; /* Number of variables in statement */ + int iParm = 0; /* Next free entry in apParm */ + int i; + Jim_Interp *interp = pDb->interp; + + *ppPreStmt = 0; + + /* Trim spaces from the start of zSql and calculate the remaining length. */ + while( isspace((unsigned)zSql[0]) ){ zSql++; } + nSql = strlen30(zSql); + + for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){ + int n = pPreStmt->nSql; + if( nSql>=n + && memcmp(pPreStmt->zSql, zSql, n)==0 + && (zSql[n]==0 || zSql[n-1]==';') + ){ + pStmt = pPreStmt->pStmt; + *pzOut = &zSql[pPreStmt->nSql]; + + /* When a prepared statement is found, unlink it from the + ** cache list. It will later be added back to the beginning + ** of the cache list in order to implement LRU replacement. + */ + if( pPreStmt->pPrev ){ + pPreStmt->pPrev->pNext = pPreStmt->pNext; + }else{ + pDb->stmtList = pPreStmt->pNext; + } + if( pPreStmt->pNext ){ + pPreStmt->pNext->pPrev = pPreStmt->pPrev; + }else{ + pDb->stmtLast = pPreStmt->pPrev; + } + pDb->nStmt--; + nVar = sqlite3_bind_parameter_count(pStmt); + break; + } + } + + /* If no prepared statement was found. Compile the SQL text. Also allocate + ** a new SqlPreparedStmt structure. */ + if( pPreStmt==0 ){ + int nByte; + + if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, pzOut) ){ + Jim_SetResult(interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db))); + return JIM_ERR; + } + if( pStmt==0 ){ + if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){ + /* A compile-time error in the statement. */ + Jim_SetResult(interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db))); + return JIM_ERR; + }else{ + /* The statement was a no-op. Continue to the next statement + ** in the SQL string. + */ + return JIM_OK; + } + } + + assert( pPreStmt==0 ); + nVar = sqlite3_bind_parameter_count(pStmt); + nByte = sizeof(SqlPreparedStmt) + nVar*sizeof(Jim_Obj *); + pPreStmt = (SqlPreparedStmt*)Jim_Alloc(nByte); + memset(pPreStmt, 0, nByte); + + pPreStmt->pStmt = pStmt; + pPreStmt->nSql = (*pzOut - zSql); + pPreStmt->zSql = sqlite3_sql(pStmt); + pPreStmt->apParm = (Jim_Obj **)&pPreStmt[1]; + } + assert( pPreStmt ); + assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql ); + assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) ); + + /* Bind values to parameters that begin with $ or : */ + for(i=1; i<=nVar; i++){ + const char *zVar = sqlite3_bind_parameter_name(pStmt, i); + if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':' || zVar[0]=='@') ){ + Jim_Obj *pVar = Jim_GetVariableStr(interp, &zVar[1], 0); + if( pVar ){ + int n; + u8 *data; + const char *zType = (pVar->typePtr ? pVar->typePtr->name : ""); + char c = zType[0]; + /* XXX: Jim Tcl doesn't have bytearray or boolean */ + if( zVar[0]=='@') { +#if 0 + || + (c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){ + /* Load a BLOB type if the Tcl variable is a bytearray and + ** it has no string representation or the host + ** parameter name begins with "@". */ + data = Jim_GetByteArrayFromObj(pVar, &n); +#else + data = (unsigned char *)Jim_GetString(pVar, &n); +#endif + sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC); + Jim_IncrRefCount(pVar); + pPreStmt->apParm[iParm++] = pVar; +#if 0 + }else if( c=='b' && strcmp(zType,"boolean")==0 ){ + Jim_GetWide(interp, pVar, &n); + sqlite3_bind_int(pStmt, i, n); +#endif + }else if( c=='d' && strcmp(zType,"double")==0 ){ + double r; + Jim_GetDouble(interp, pVar, &r); + sqlite3_bind_double(pStmt, i, r); + }else if( (c=='c' && strcmp(zType,"coerced-double")==0) || + (c=='i' && strcmp(zType,"int")==0) ){ + jim_wide v; + Jim_GetWide(interp, pVar, &v); + sqlite3_bind_int64(pStmt, i, v); + }else{ + data = (unsigned char *)Jim_GetString(pVar, &n); + sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC); + Jim_IncrRefCount(pVar); + pPreStmt->apParm[iParm++] = pVar; + } + }else{ + sqlite3_bind_null(pStmt, i); + } + } + } + pPreStmt->nParm = iParm; + *ppPreStmt = pPreStmt; + + return JIM_OK; +} + + +/* +** Release a statement reference obtained by calling dbPrepareAndBind(). +** There should be exactly one call to this function for each call to +** dbPrepareAndBind(). +** +** If the discard parameter is non-zero, then the statement is deleted +** immediately. Otherwise it is added to the LRU list and may be returned +** by a subsequent call to dbPrepareAndBind(). +*/ +static void dbReleaseStmt( + SqliteDb *pDb, /* Database handle */ + SqlPreparedStmt *pPreStmt, /* Prepared statement handle to release */ + int discard /* True to delete (not cache) the pPreStmt */ +){ + int i; + + /* Free the bound string and blob parameters */ + for(i=0; inParm; i++){ + Jim_DecrRefCount(pDb->interp, pPreStmt->apParm[i]); + } + pPreStmt->nParm = 0; + + if( pDb->maxStmt<=0 || discard ){ + /* If the cache is turned off, deallocated the statement */ + sqlite3_finalize(pPreStmt->pStmt); + Jim_Free((char *)pPreStmt); + }else{ + /* Add the prepared statement to the beginning of the cache list. */ + pPreStmt->pNext = pDb->stmtList; + pPreStmt->pPrev = 0; + if( pDb->stmtList ){ + pDb->stmtList->pPrev = pPreStmt; + } + pDb->stmtList = pPreStmt; + if( pDb->stmtLast==0 ){ + assert( pDb->nStmt==0 ); + pDb->stmtLast = pPreStmt; + }else{ + assert( pDb->nStmt>0 ); + } + pDb->nStmt++; + + /* If we have too many statement in cache, remove the surplus from + ** the end of the cache list. */ + while( pDb->nStmt>pDb->maxStmt ){ + sqlite3_finalize(pDb->stmtLast->pStmt); + pDb->stmtLast = pDb->stmtLast->pPrev; + Jim_Free((char*)pDb->stmtLast->pNext); + pDb->stmtLast->pNext = 0; + pDb->nStmt--; + } + } +} + +/* +** Structure used with dbEvalXXX() functions: +** +** dbEvalInit() +** dbEvalStep() +** dbEvalFinalize() +** dbEvalRowInfo() +** dbEvalColumnValue() +*/ +typedef struct DbEvalContext DbEvalContext; +struct DbEvalContext { + SqliteDb *pDb; /* Database handle */ + Jim_Obj *pSql; /* Object holding string zSql */ + const char *zSql; /* Remaining SQL to execute */ + SqlPreparedStmt *pPreStmt; /* Current statement */ + int nCol; /* Number of columns returned by pStmt */ + Jim_Obj *pArray; /* Name of array variable */ + Jim_Obj **apColName; /* Array of column names */ +}; + +/* +** Release any cache of column names currently held as part of +** the DbEvalContext structure passed as the first argument. +*/ +static void dbReleaseColumnNames(DbEvalContext *p){ + if( p->apColName ){ + int i; + for(i=0; inCol; i++){ + Jim_DecrRefCount(p->pDb->interp, p->apColName[i]); + } + Jim_Free((char *)p->apColName); + p->apColName = 0; + } + p->nCol = 0; +} + +/* +** Initialize a DbEvalContext structure. +** +** If pArray is not NULL, then it contains the name of a Tcl array +** variable. The "*" member of this array is set to a list containing +** the names of the columns returned by the statement as part of each +** call to dbEvalStep(), in order from left to right. e.g. if the names +** of the returned columns are a, b and c, it does the equivalent of the +** tcl command: +** +** set ${pArray}(*) {a b c} +*/ +static void dbEvalInit( + DbEvalContext *p, /* Pointer to structure to initialize */ + SqliteDb *pDb, /* Database handle */ + Jim_Obj *pSql, /* Object containing SQL script */ + Jim_Obj *pArray /* Name of Tcl array to set (*) element of */ +){ + memset(p, 0, sizeof(DbEvalContext)); + p->pDb = pDb; + p->zSql = Jim_String(pSql); + p->pSql = pSql; + Jim_IncrRefCount(pSql); + if( pArray ){ + p->pArray = pArray; + Jim_IncrRefCount(pArray); + } +} + +/* +** Obtain information about the row that the DbEvalContext passed as the +** first argument currently points to. +*/ +static void dbEvalRowInfo( + DbEvalContext *p, /* Evaluation context */ + int *pnCol, /* OUT: Number of column names */ + Jim_Obj ***papColName /* OUT: Array of column names */ +){ + /* Compute column names */ + if( 0==p->apColName ){ + sqlite3_stmt *pStmt = p->pPreStmt->pStmt; + int i; /* Iterator variable */ + int nCol; /* Number of columns returned by pStmt */ + Jim_Obj **apColName = 0; /* Array of column names */ + + p->nCol = nCol = sqlite3_column_count(pStmt); + if( nCol>0 && (papColName || p->pArray) ){ + apColName = (Jim_Obj**)Jim_Alloc( sizeof(Jim_Obj*)*nCol ); + for(i=0; ipDb->interp, sqlite3_column_name(pStmt,i)); + Jim_IncrRefCount(apColName[i]); + } + p->apColName = apColName; + } + + /* If results are being stored in an array variable, then create + ** the array(*) entry for that array + */ + if( p->pArray ){ + Jim_Interp *interp = p->pDb->interp; + Jim_Obj *pColList = Jim_NewListObj(interp, apColName, nCol); + Jim_Obj *pStar = Jim_NewStringObj(interp, "*", -1); + Jim_IncrRefCount(pStar); + Jim_SetDictKeysVector(interp, p->pArray, &pStar, 1, pColList, 0); + Jim_DecrRefCount(interp, pStar); + } + } + + if( papColName ){ + *papColName = p->apColName; + } + if( pnCol ){ + *pnCol = p->nCol; + } +} + +/* +** Return one of JIM_OK, JIM_BREAK or JIM_ERR. If JIM_ERR is +** returned, then an error message is stored in the interpreter before +** returning. +** +** A return value of JIM_OK means there is a row of data available. The +** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This +** is analogous to a return of SQLITE_ROW from sqlite3_step(). If JIM_BREAK +** is returned, then the SQL script has finished executing and there are +** no further rows available. This is similar to SQLITE_DONE. +*/ +static int dbEvalStep(DbEvalContext *p){ + while( p->zSql[0] || p->pPreStmt ){ + int rc; + if( p->pPreStmt==0 ){ + rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt); + if( rc!=JIM_OK ) return rc; + }else{ + int rcs; + SqliteDb *pDb = p->pDb; + SqlPreparedStmt *pPreStmt = p->pPreStmt; + sqlite3_stmt *pStmt = pPreStmt->pStmt; + + rcs = sqlite3_step(pStmt); + if( rcs==SQLITE_ROW ){ + return JIM_OK; + } + if( p->pArray ){ + dbEvalRowInfo(p, 0, 0); + } + rcs = sqlite3_reset(pStmt); + + pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1); + pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1); + dbReleaseColumnNames(p); + p->pPreStmt = 0; + + if( rcs!=SQLITE_OK ){ + /* If a run-time error occurs, report the error and stop reading + ** the SQL. */ + Jim_SetResult(pDb->interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db))); + dbReleaseStmt(pDb, pPreStmt, 1); + return JIM_ERR; + }else{ + dbReleaseStmt(pDb, pPreStmt, 0); + } + } + } + + /* Finished */ + return JIM_BREAK; +} + +/* +** Free all resources currently held by the DbEvalContext structure passed +** as the first argument. There should be exactly one call to this function +** for each call to dbEvalInit(). +*/ +static void dbEvalFinalize(DbEvalContext *p){ + if( p->pPreStmt ){ + sqlite3_reset(p->pPreStmt->pStmt); + dbReleaseStmt(p->pDb, p->pPreStmt, 0); + p->pPreStmt = 0; + } + if( p->pArray ){ + Jim_DecrRefCount(p->pDb->interp, p->pArray); + p->pArray = 0; + } + Jim_DecrRefCount(p->pDb->interp, p->pSql); + dbReleaseColumnNames(p); +} + +/* +** Return a pointer to a Jim_Obj structure with ref-count 0 that contains +** the value for the iCol'th column of the row currently pointed to by +** the DbEvalContext structure passed as the first argument. +*/ +static Jim_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){ + sqlite3_stmt *pStmt = p->pPreStmt->pStmt; + switch( sqlite3_column_type(pStmt, iCol) ){ + case SQLITE_BLOB: { + int bytes = sqlite3_column_bytes(pStmt, iCol); + const char *zBlob = sqlite3_column_blob(pStmt, iCol); + if( !zBlob ) bytes = 0; + //return Jim_NewByteArrayObj((u8*)zBlob, bytes); + return Jim_NewStringObj(p->pDb->interp, zBlob, bytes); + } + case SQLITE_INTEGER: { + sqlite_int64 v = sqlite3_column_int64(pStmt, iCol); + return Jim_NewIntObj(p->pDb->interp, v); + } + case SQLITE_FLOAT: { + return Jim_NewDoubleObj(p->pDb->interp, sqlite3_column_double(pStmt, iCol)); + } + case SQLITE_NULL: { + return dbTextToObj(p->pDb->interp, p->pDb->zNull); + } + } + + return dbTextToObj(p->pDb->interp, (char *)sqlite3_column_text(pStmt, iCol)); +} + +static int Jim_ObjSetVar2(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *keyObjPtr, Jim_Obj *valObjPtr) +{ + return Jim_SetDictKeysVector(interp, nameObjPtr, &keyObjPtr, 1, valObjPtr, 0); +} + +/* +** This function is part of the implementation of the command: +** +** $db eval SQL ?ARRAYNAME? SCRIPT +*/ +static int DbEvalNextCmd( + Jim_Interp *interp, /* Tcl interpreter */ + DbEvalContext *p, + Jim_Obj *pScript, + int result /* Result so far */ +){ + int rc = result; /* Return code */ + + Jim_Obj *pArray = p->pArray; + + while( (rc==JIM_OK || rc==JIM_CONTINUE) && JIM_OK==(rc = dbEvalStep(p)) ){ + int i; + int nCol; + Jim_Obj **apColName; + dbEvalRowInfo(p, &nCol, &apColName); + for(i=0; i3 ){ + Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); + return JIM_ERR; + }else if( objc==2 ){ + if( pDb->zAuth ){ + Jim_SetResultString(interp, pDb->zAuth, -1); + } + }else{ + const char *zAuth; + int len; + if( pDb->zAuth ){ + Jim_Free(pDb->zAuth); + } + zAuth = Jim_GetString(objv[2], &len); + if( zAuth && len>0 ){ + pDb->zAuth = Jim_Alloc( len + 1 ); + memcpy(pDb->zAuth, zAuth, len+1); + }else{ + pDb->zAuth = 0; + } + if( pDb->zAuth ){ + pDb->interp = interp; + sqlite3_set_authorizer(pDb->db, auth_callback, pDb); + }else{ + sqlite3_set_authorizer(pDb->db, 0, 0); + } + } +#endif + break; + } + + /* $db backup ?DATABASE? FILENAME + ** + ** Open or create a database file named FILENAME. Transfer the + ** content of local database DATABASE (default: "main") into the + ** FILENAME database. + */ + case DB_BACKUP: { + const char *zDestFile; + const char *zSrcDb; + sqlite3 *pDest; + sqlite3_backup *pBackup; + + if( objc==3 ){ + zSrcDb = "main"; + zDestFile = Jim_String(objv[2]); + }else if( objc==4 ){ + zSrcDb = Jim_String(objv[2]); + zDestFile = Jim_String(objv[3]); + }else{ + Jim_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); + return JIM_ERR; + } + rc = sqlite3_open(zDestFile, &pDest); + if( rc!=SQLITE_OK ){ + Jim_SetResultFormatted(interp, "cannot open target database: %s", sqlite3_errmsg(pDest)); + sqlite3_close(pDest); + return JIM_ERR; + } + pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb); + if( pBackup==0 ){ + Jim_SetResultFormatted(interp, "backup failed: %s", sqlite3_errmsg(pDest)); + sqlite3_close(pDest); + return JIM_ERR; + } + while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){} + sqlite3_backup_finish(pBackup); + if( rc==SQLITE_DONE ){ + rc = JIM_OK; + }else{ + Jim_SetResultFormatted(interp, "backup failed: %s", sqlite3_errmsg(pDest)); + rc = JIM_ERR; + } + sqlite3_close(pDest); + break; + } + + /* $db busy ?CALLBACK? + ** + ** Invoke the given callback if an SQL statement attempts to open + ** a locked database file. + */ + case DB_BUSY: { + if( objc>3 ){ + Jim_WrongNumArgs(interp, 2, objv, "CALLBACK"); + return JIM_ERR; + }else if( objc==2 ){ + if( pDb->zBusy ){ + Jim_SetResultString(interp, pDb->zBusy, -1); + } + }else{ + const char *zBusy; + int len; + if( pDb->zBusy ){ + Jim_Free(pDb->zBusy); + } + zBusy = Jim_GetString(objv[2], &len); + if( zBusy && len>0 ){ + pDb->zBusy = Jim_Alloc( len + 1 ); + memcpy(pDb->zBusy, zBusy, len+1); + }else{ + pDb->zBusy = 0; + } + if( pDb->zBusy ){ + pDb->interp = interp; + sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb); + }else{ + sqlite3_busy_handler(pDb->db, 0, 0); + } + } + break; + } + + /* $db cache flush + ** $db cache size n + ** + ** Flush the prepared statement cache, or set the maximum number of + ** cached statements. + */ + case DB_CACHE: { + const char *subCmd; + + if( objc<=2 ){ + Jim_WrongNumArgs(interp, 1, objv, "cache option ?arg?"); + return JIM_ERR; + } + subCmd = Jim_String( objv[2]); + if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){ + if( objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "flush"); + return JIM_ERR; + }else{ + flushStmtCache( pDb ); + } + }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){ + if( objc!=4 ){ + Jim_WrongNumArgs(interp, 2, objv, "size n"); + return JIM_ERR; + }else{ + jim_wide w; + if( JIM_ERR==Jim_GetWide(interp, objv[3], &w) ){ + return JIM_ERR; + }else{ + if( w<0 ){ + flushStmtCache( pDb ); + w = 0; + }else if( w>MAX_PREPARED_STMTS ){ + w = MAX_PREPARED_STMTS; + } + pDb->maxStmt = w; + } + } + }else{ + Jim_SetResultFormatted(interp, "bad option \"%#s\": must be flush or size", objv[2]); + return JIM_ERR; + } + break; + } + + /* $db changes + ** + ** Return the number of rows that were modified, inserted, or deleted by + ** the most recent INSERT, UPDATE or DELETE statement, not including + ** any changes made by trigger programs. + */ + case DB_CHANGES: { + if( objc!=2 ){ + Jim_WrongNumArgs(interp, 2, objv, ""); + return JIM_ERR; + } + Jim_SetResultInt(interp, sqlite3_changes(pDb->db)); + break; + } + + /* $db close + ** + ** Shutdown the database + */ + case DB_CLOSE: { + Jim_DeleteCommand(interp, objv[0]); + break; + } + + /* + ** $db collate NAME SCRIPT + ** + ** Create a new SQL collation function called NAME. Whenever + ** that function is called, invoke SCRIPT to evaluate the function. + */ + case DB_COLLATE: { + SqlCollate *pCollate; + const char *zName; + const char *zScript; + int nScript; + if( objc!=4 ){ + Jim_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); + return JIM_ERR; + } + zName = Jim_String(objv[2]); + zScript = Jim_GetString(objv[3], &nScript); + pCollate = (SqlCollate*)Jim_Alloc( sizeof(*pCollate) + nScript + 1 ); + if( pCollate==0 ) return JIM_ERR; + pCollate->interp = interp; + pCollate->pNext = pDb->pCollate; + pCollate->zScript = (char*)&pCollate[1]; + pDb->pCollate = pCollate; + memcpy(pCollate->zScript, zScript, nScript+1); + if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, + pCollate, tclSqlCollate) ){ + Jim_SetResultString(interp, (char *)sqlite3_errmsg(pDb->db), -1); + return JIM_ERR; + } + break; + } + + /* + ** $db collation_needed SCRIPT + ** + ** Create a new SQL collation function called NAME. Whenever + ** that function is called, invoke SCRIPT to evaluate the function. + */ + case DB_COLLATION_NEEDED: { + if( objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "SCRIPT"); + return JIM_ERR; + } + if( pDb->pCollateNeeded ){ + Jim_DecrRefCount(interp, pDb->pCollateNeeded); + } + pDb->pCollateNeeded = Jim_DuplicateObj(pDb->interp, objv[2]); + Jim_IncrRefCount(pDb->pCollateNeeded); + sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded); + break; + } + + /* $db commit_hook ?CALLBACK? + ** + ** Invoke the given callback just before committing every SQL transaction. + ** If the callback throws an exception or returns non-zero, then the + ** transaction is aborted. If CALLBACK is an empty string, the callback + ** is disabled. + */ + case DB_COMMIT_HOOK: { + if( objc>3 ){ + Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); + return JIM_ERR; + }else if( objc==2 ){ + if( pDb->zCommit ){ + Jim_SetResultString(interp, pDb->zCommit, -1); + } + }else{ + const char *zCommit; + int len; + if( pDb->zCommit ){ + Jim_Free(pDb->zCommit); + } + zCommit = Jim_GetString(objv[2], &len); + if( zCommit && len>0 ){ + pDb->zCommit = Jim_Alloc( len + 1 ); + memcpy(pDb->zCommit, zCommit, len+1); + }else{ + pDb->zCommit = 0; + } + if( pDb->zCommit ){ + pDb->interp = interp; + sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb); + }else{ + sqlite3_commit_hook(pDb->db, 0, 0); + } + } + break; + } + + /* $db complete SQL + ** + ** Return TRUE if SQL is a complete SQL statement. Return FALSE if + ** additional lines of input are needed. This is similar to the + ** built-in "info complete" command of Tcl. + */ + case DB_COMPLETE: { +#ifndef SQLITE_OMIT_COMPLETE + if( objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "SQL"); + return JIM_ERR; + } + Jim_SetResultInt(interp, sqlite3_complete( Jim_String(objv[2]) )); +#endif + break; + } + + /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR? + ** + ** Copy data into table from filename, optionally using SEPARATOR + ** as column separators. If a column contains a null string, or the + ** value of NULLINDICATOR, a NULL is inserted for the column. + ** conflict-algorithm is one of the sqlite conflict algorithms: + ** rollback, abort, fail, ignore, replace + ** On success, return the number of lines processed, not necessarily same + ** as 'db changes' due to conflict-algorithm selected. + ** + ** This code is basically an implementation/enhancement of + ** the sqlite3 shell.c ".import" command. + ** + ** This command usage is equivalent to the sqlite2.x COPY statement, + ** which imports file data into a table using the PostgreSQL COPY file format: + ** $db copy $conflit_algo $table_name $filename \t \\N + */ + case DB_COPY: { + const char *zTable; /* Insert data into this table */ + const char *zFile; /* The file from which to extract data */ + const char *zConflict; /* The conflict algorithm to use */ + sqlite3_stmt *pStmt; /* A statement */ + int nCol; /* Number of columns in the table */ + int nByte; /* Number of bytes in an SQL string */ + int i, j; /* Loop counters */ + int nSep; /* Number of bytes in zSep[] */ + int nNull; /* Number of bytes in zNull[] */ + char *zSql; /* An SQL statement */ + char *zLine; /* A single line of input from the file */ + char **azCol; /* zLine[] broken up into columns */ + char *zCommit; /* How to commit changes */ + FILE *in; /* The input file */ + int lineno = 0; /* Line number of input file */ + char zLineNum[80]; /* Line number print buffer */ + + const char *zSep; + const char *zNull; + if( objc<5 || objc>7 ){ + Jim_WrongNumArgs(interp, 2, objv, + "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"); + return JIM_ERR; + } + if( objc>=6 ){ + zSep = Jim_String(objv[5]); + }else{ + zSep = "\t"; + } + if( objc>=7 ){ + zNull = Jim_String(objv[6]); + }else{ + zNull = ""; + } + zConflict = Jim_String(objv[2]); + zTable = Jim_String(objv[3]); + zFile = Jim_String(objv[4]); + nSep = strlen30(zSep); + nNull = strlen30(zNull); + if( nSep==0 ){ + Jim_SetResultString(interp, "Error: non-null separator required for copy", -1); + return JIM_ERR; + } + if(strcmp(zConflict, "rollback") != 0 && + strcmp(zConflict, "abort" ) != 0 && + strcmp(zConflict, "fail" ) != 0 && + strcmp(zConflict, "ignore" ) != 0 && + strcmp(zConflict, "replace" ) != 0 ) { + Jim_SetResultFormatted(interp, "Error: \"%s\", conflict-algorithm must be one of: rollback, " + "abort, fail, ignore, or replace", zConflict); + return JIM_ERR; + } + zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable); + if( zSql==0 ){ + Jim_SetResultFormatted(interp, "Error: no such table: %s", zTable); + return JIM_ERR; + } + nByte = strlen30(zSql); + rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); + sqlite3_free(zSql); + if( rc ){ + Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db)); + nCol = 0; + }else{ + nCol = sqlite3_column_count(pStmt); + } + sqlite3_finalize(pStmt); + if( nCol==0 ) { + return JIM_ERR; + } + zSql = Jim_Alloc( nByte + 50 + nCol*2 ); + sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?", + zConflict, zTable); + j = strlen30(zSql); + for(i=1; idb, zSql, -1, &pStmt, 0); + Jim_Free(zSql); + if( rc ){ + Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db)); + sqlite3_finalize(pStmt); + return JIM_ERR; + } + in = fopen(zFile, "rb"); + if( in==0 ){ + Jim_SetResultFormatted(interp, "Error: cannot open file: %s", zFile); + sqlite3_finalize(pStmt); + return JIM_ERR; + } + azCol = Jim_Alloc( sizeof(azCol[0])*(nCol+1) ); + (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0); + zCommit = "COMMIT"; + while( (zLine = local_getline(0, in))!=0 ){ + char *z; + i = 0; + lineno++; + azCol[0] = zLine; + for(i=0, z=zLine; *z; z++){ + if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){ + *z = 0; + i++; + if( i0 && strcmp(azCol[i], zNull)==0) + || strlen30(azCol[i])==0 + ){ + sqlite3_bind_null(pStmt, i+1); + }else{ + sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC); + } + } + sqlite3_step(pStmt); + rc = sqlite3_reset(pStmt); + Jim_Free(zLine); + if( rc!=SQLITE_OK ){ + Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db)); + zCommit = "ROLLBACK"; + break; + } + } + Jim_Free(azCol); + fclose(in); + sqlite3_finalize(pStmt); + (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0); + + if( zCommit[0] == 'C' ){ + /* success, set result as number of lines processed */ + Jim_SetResultInt(interp, lineno); + rc = JIM_OK; + }else{ + /* failure, append lineno where failed */ + sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno); + Jim_AppendStrings(interp, Jim_GetResult(interp), ", failed while processing line: ", zLineNum, NULL); + rc = JIM_ERR; + } + break; + } + + /* + ** $db enable_load_extension BOOLEAN + ** + ** Turn the extension loading feature on or off. It if off by + ** default. + */ + case DB_ENABLE_LOAD_EXTENSION: { +#ifndef SQLITE_OMIT_LOAD_EXTENSION + long onoff; + if( objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "BOOLEAN"); + return JIM_ERR; + } + if( Jim_GetLong(interp, objv[2], &onoff) ){ + return JIM_ERR; + } + sqlite3_enable_load_extension(pDb->db, onoff); + break; +#else + Jim_SetResultString(interp, "extension loading is turned off at compile-time", -1); + return JIM_ERR; +#endif + } + + /* + ** $db errorcode + ** + ** Return the numeric error code that was returned by the most recent + ** call to sqlite3_exec(). + */ + case DB_ERRORCODE: { + Jim_SetResultInt(interp, sqlite3_errcode(pDb->db)); + break; + } + + /* + ** $db exists $sql + ** $db onecolumn $sql + ** + ** The onecolumn method is the equivalent of: + ** lindex [$db eval $sql] 0 + */ + case DB_EXISTS: + case DB_ONECOLUMN: { + DbEvalContext sEval; + if( objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "SQL"); + return JIM_ERR; + } + + dbEvalInit(&sEval, pDb, objv[2], 0); + rc = dbEvalStep(&sEval); + if( choice==DB_ONECOLUMN ){ + if( rc==JIM_OK ){ + Jim_SetResult(interp, dbEvalColumnValue(&sEval, 0)); + } + }else if( rc==JIM_BREAK || rc==JIM_OK ){ + Jim_SetResultInt(interp, rc==JIM_OK); + } + dbEvalFinalize(&sEval); + + if( rc==JIM_BREAK ){ + rc = JIM_OK; + } + break; + } + + /* + ** $db eval $sql ?array? ?{ ...code... }? + ** + ** The SQL statement in $sql is evaluated. For each row, the values are + ** placed in elements of the array named "array" and ...code... is executed. + ** If "array" and "code" are omitted, then no callback is every invoked. + ** If "array" is an empty string, then the values are placed in variables + ** that have the same name as the fields extracted by the query. + */ + case DB_EVAL: { + if( objc<3 || objc>5 ){ + Jim_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?"); + return JIM_ERR; + } + + if( objc==3 ){ + DbEvalContext sEval; + Jim_Obj *pRet = Jim_NewListObj(interp, NULL, 0); + Jim_IncrRefCount(pRet); + dbEvalInit(&sEval, pDb, objv[2], 0); + while( JIM_OK==(rc = dbEvalStep(&sEval)) ){ + int i; + int nCol; + dbEvalRowInfo(&sEval, &nCol, 0); + for(i=0; i2 && strncmp(z, "-argcount",n)==0 ){ + if( Jim_GetLong(interp, objv[4], &nArg) ) return JIM_ERR; + if( nArg<0 ){ + Jim_SetResultString(interp, "number of arguments must be non-negative", -1); + return JIM_ERR; + } + } + pScript = objv[5]; + }else if( objc!=4 ){ + Jim_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT"); + return JIM_ERR; + }else{ + pScript = objv[3]; + } + zName = Jim_String(objv[2]); + pFunc = findSqlFunc(pDb, zName); + if( pFunc==0 ) return JIM_ERR; + if( pFunc->pScript ){ + Jim_DecrRefCount(interp, pFunc->pScript); + } + pFunc->pScript = pScript; + Jim_IncrRefCount(pScript); + pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); + rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8, + pFunc, tclSqlFunc, 0, 0); + if( rc!=SQLITE_OK ){ + rc = JIM_ERR; + Jim_SetResultString(interp, (char *)sqlite3_errmsg(pDb->db), -1); + } + break; + } + + /* + ** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID + */ + case DB_INCRBLOB: { +#ifdef SQLITE_OMIT_INCRBLOB + Jim_SetResultString(interp, "incrblob not available in this build", -1); + return JIM_ERR; +#else + int isReadonly = 0; + const char *zDb = "main"; + const char *zTable; + const char *zColumn; + sqlite_int64 iRow; + + /* Check for the -readonly option */ + if( objc>3 && strcmp(Jim_GetString(objv[2]), "-readonly")==0 ){ + isReadonly = 1; + } + + if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){ + Jim_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID"); + return JIM_ERR; + } + + if( objc==(6+isReadonly) ){ + zDb = Jim_GetString(objv[2]); + } + zTable = Jim_GetString(objv[objc-3]); + zColumn = Jim_GetString(objv[objc-2]); + rc = Jim_GetWide(interp, objv[objc-1], &iRow); + + if( rc==JIM_OK ){ + rc = createIncrblobChannel( + interp, pDb, zDb, zTable, zColumn, iRow, isReadonly + ); + } +#endif + break; + } + + /* + ** $db interrupt + ** + ** Interrupt the execution of the inner-most SQL interpreter. This + ** causes the SQL statement to return an error of SQLITE_INTERRUPT. + */ + case DB_INTERRUPT: { + sqlite3_interrupt(pDb->db); + break; + } + + /* + ** $db nullvalue ?STRING? + ** + ** Change text used when a NULL comes back from the database. If ?STRING? + ** is not present, then the current string used for NULL is returned. + ** If STRING is present, then STRING is returned. + ** + */ + case DB_NULLVALUE: { + if( objc!=2 && objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "NULLVALUE"); + return JIM_ERR; + } + if( objc==3 ){ + int len; + const char *zNull = Jim_GetString(objv[2], &len); + if( pDb->zNull ){ + Jim_Free(pDb->zNull); + } + if( zNull && len>0 ){ + pDb->zNull = Jim_Alloc( len + 1 ); + strncpy(pDb->zNull, zNull, len); + pDb->zNull[len] = '\0'; + }else{ + pDb->zNull = 0; + } + } + Jim_SetResult(interp, dbTextToObj(interp, pDb->zNull)); + break; + } + + /* + ** $db last_insert_rowid + ** + ** Return an integer which is the ROWID for the most recent insert. + */ + case DB_LAST_INSERT_ROWID: { + if( objc!=2 ){ + Jim_WrongNumArgs(interp, 2, objv, ""); + return JIM_ERR; + } + Jim_SetResultInt(interp, sqlite3_last_insert_rowid(pDb->db)); + break; + } + + /* + ** The DB_ONECOLUMN method is implemented together with DB_EXISTS. + */ + + /* $db progress ?N CALLBACK? + ** + ** Invoke the given callback every N virtual machine opcodes while executing + ** queries. + */ + case DB_PROGRESS: { + if( objc==2 ){ + if( pDb->zProgress ){ + Jim_AppendString(interp, Jim_GetResult(interp), pDb->zProgress, -1); + } + }else if( objc==4 ){ + const char *zProgress; + int len; + long N; + if( JIM_OK!=Jim_GetLong(interp, objv[2], &N) ){ + return JIM_ERR; + }; + if( pDb->zProgress ){ + Jim_Free(pDb->zProgress); + } + zProgress = Jim_GetString(objv[3], &len); + if( zProgress && len>0 ){ + pDb->zProgress = Jim_Alloc( len + 1 ); + memcpy(pDb->zProgress, zProgress, len+1); + }else{ + pDb->zProgress = 0; + } +#ifndef SQLITE_OMIT_PROGRESS_CALLBACK + if( pDb->zProgress ){ + pDb->interp = interp; + sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb); + }else{ + sqlite3_progress_handler(pDb->db, 0, 0, 0); + } +#endif + }else{ + Jim_WrongNumArgs(interp, 2, objv, "N CALLBACK"); + return JIM_ERR; + } + break; + } + + /* $db profile ?CALLBACK? + ** + ** Make arrangements to invoke the CALLBACK routine after each SQL statement + ** that has run. The text of the SQL and the amount of elapse time are + ** appended to CALLBACK before the script is run. + */ + case DB_PROFILE: { + if( objc>3 ){ + Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); + return JIM_ERR; + }else if( objc==2 ){ + if( pDb->zProfile ){ + Jim_SetResultString(interp, pDb->zProfile, -1); + } + }else{ + const char *zProfile; + int len; + if( pDb->zProfile ){ + Jim_Free(pDb->zProfile); + } + zProfile = Jim_GetString(objv[2], &len); + if( zProfile && len>0 ){ + pDb->zProfile = Jim_Alloc( len + 1 ); + memcpy(pDb->zProfile, zProfile, len+1); + }else{ + pDb->zProfile = 0; + } +#ifndef SQLITE_OMIT_TRACE + if( pDb->zProfile ){ + pDb->interp = interp; + sqlite3_profile(pDb->db, DbProfileHandler, pDb); + }else{ + sqlite3_profile(pDb->db, 0, 0); + } +#endif + } + break; + } + + /* + ** $db rekey KEY + ** + ** Change the encryption key on the currently open database. + */ + case DB_REKEY: { + int nKey; + const char *pKey; + if( objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "KEY"); + return JIM_ERR; + } + //pKey = Jim_GetByteArrayFromObj(objv[2], &nKey); + pKey = Jim_GetString(objv[2], &nKey); +#ifdef SQLITE_HAS_CODEC + rc = sqlite3_rekey(pDb->db, pKey, nKey); + if( rc ){ + Jim_SetResultString(interp, sqlite3ErrStr(rc), -1); + rc = JIM_ERR; + } +#endif + break; + } + + /* $db restore ?DATABASE? FILENAME + ** + ** Open a database file named FILENAME. Transfer the content + ** of FILENAME into the local database DATABASE (default: "main"). + */ + case DB_RESTORE: { + const char *zSrcFile; + const char *zDestDb; + sqlite3 *pSrc; + sqlite3_backup *pBackup; + int nTimeout = 0; + + if( objc==3 ){ + zDestDb = "main"; + zSrcFile = Jim_String(objv[2]); + }else if( objc==4 ){ + zDestDb = Jim_String(objv[2]); + zSrcFile = Jim_String(objv[3]); + }else{ + Jim_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME"); + return JIM_ERR; + } + rc = sqlite3_open_v2(zSrcFile, &pSrc, SQLITE_OPEN_READONLY, 0); + if( rc!=SQLITE_OK ){ + Jim_SetResultFormatted(interp, "cannot open source database: %s", sqlite3_errmsg(pSrc)); + sqlite3_close(pSrc); + return JIM_ERR; + } + pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main"); + if( pBackup==0 ){ + Jim_SetResultFormatted(interp, "restore failed: %s", sqlite3_errmsg(pDb->db)); + sqlite3_close(pSrc); + return JIM_ERR; + } + while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK + || rc==SQLITE_BUSY ){ + if( rc==SQLITE_BUSY ){ + if( nTimeout++ >= 3 ) break; + sqlite3_sleep(100); + } + } + sqlite3_backup_finish(pBackup); + if( rc==SQLITE_DONE ){ + rc = JIM_OK; + }else if( rc==SQLITE_BUSY || rc==SQLITE_LOCKED ){ + Jim_SetResultString(interp, "restore failed: source database busy", -1); + rc = JIM_ERR; + }else{ + Jim_SetResultFormatted(interp, "restore failed: %s", sqlite3_errmsg(pDb->db)); + rc = JIM_ERR; + } + sqlite3_close(pSrc); + break; + } + + /* + ** $db status (step|sort) + ** + ** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or + ** SQLITE_STMTSTATUS_SORT for the most recent eval. + */ + case DB_STATUS: { + int v; + const char *zOp; + if( objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "(step|sort)"); + return JIM_ERR; + } + zOp = Jim_String(objv[2]); + if( strcmp(zOp, "step")==0 ){ + v = pDb->nStep; + }else if( strcmp(zOp, "sort")==0 ){ + v = pDb->nSort; + }else{ + Jim_SetResultString(interp, "bad argument: should be step or sort", -1); + return JIM_ERR; + } + Jim_SetResultInt(interp, v); + break; + } + + /* + ** $db timeout MILLESECONDS + ** + ** Delay for the number of milliseconds specified when a file is locked. + */ + case DB_TIMEOUT: { + long ms; + if( objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "MILLISECONDS"); + return JIM_ERR; + } + if( Jim_GetLong(interp, objv[2], &ms) ) return JIM_ERR; + sqlite3_busy_timeout(pDb->db, ms); + break; + } + + /* + ** $db total_changes + ** + ** Return the number of rows that were modified, inserted, or deleted + ** since the database handle was created. + */ + case DB_TOTAL_CHANGES: { + if( objc!=2 ){ + Jim_WrongNumArgs(interp, 2, objv, ""); + return JIM_ERR; + } + Jim_SetResultInt(interp, sqlite3_total_changes(pDb->db)); + break; + } + + /* $db trace ?CALLBACK? + ** + ** Make arrangements to invoke the CALLBACK routine for each SQL statement + ** that is executed. The text of the SQL is appended to CALLBACK before + ** it is executed. + */ + case DB_TRACE: { + if( objc>3 ){ + Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); + return JIM_ERR; + }else if( objc==2 ){ + if( pDb->zTrace ){ + Jim_AppendString(interp, Jim_GetResult(interp), pDb->zTrace, -1); + } + }else{ + const char *zTrace; + int len; + if( pDb->zTrace ){ + Jim_Free(pDb->zTrace); + } + zTrace = Jim_GetString(objv[2], &len); + if( zTrace && len>0 ){ + pDb->zTrace = Jim_Alloc( len + 1 ); + memcpy(pDb->zTrace, zTrace, len+1); + }else{ + pDb->zTrace = 0; + } +#ifndef SQLITE_OMIT_TRACE + if( pDb->zTrace ){ + pDb->interp = interp; + sqlite3_trace(pDb->db, DbTraceHandler, pDb); + }else{ + sqlite3_trace(pDb->db, 0, 0); + } +#endif + } + break; + } + + /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT + ** + ** Start a new transaction (if we are not already in the midst of a + ** transaction) and execute the TCL script SCRIPT. After SCRIPT + ** completes, either commit the transaction or roll it back if SCRIPT + ** throws an exception. Or if no new transation was started, do nothing. + ** pass the exception on up the stack. + ** + ** This command was inspired by Dave Thomas's talk on Ruby at the + ** 2005 O'Reilly Open Source Convention (OSCON). + */ + case DB_TRANSACTION: { + Jim_Obj *pScript; + const char *zBegin = "SAVEPOINT _tcl_transaction"; + if( objc!=3 && objc!=4 ){ + Jim_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT"); + return JIM_ERR; + } + + if( pDb->nTransaction==0 && objc==4 ){ + static const char *TTYPE_strs[] = { + "deferred", "exclusive", "immediate", 0 + }; + enum TTYPE_enum { + TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE + }; + int ttype; + if( Jim_GetEnum(interp, objv[2], TTYPE_strs, &ttype, "transaction type", JIM_ERRMSG | JIM_ENUM_ABBREV) ){ + return JIM_ERR; + } + switch( (enum TTYPE_enum)ttype ){ + case TTYPE_DEFERRED: /* no-op */; break; + case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break; + case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break; + } + } + pScript = objv[objc-1]; + + /* Run the SQLite BEGIN command to open a transaction or savepoint. */ + pDb->disableAuth++; + rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0); + pDb->disableAuth--; + if( rc!=SQLITE_OK ){ + Jim_SetResultString(interp, sqlite3_errmsg(pDb->db), -1); + return JIM_ERR; + } + pDb->nTransaction++; + + /* No NRE in Jim Tcl, so evaluate the script directly, then + ** call function DbTransPostCmd() to commit (or rollback) the transaction + ** or savepoint. */ + rc = DbTransPostCmd(interp, pDb, Jim_EvalObj(interp, pScript)); + break; + } + + /* + ** $db unlock_notify ?script? + */ + case DB_UNLOCK_NOTIFY: { +#ifndef SQLITE_ENABLE_UNLOCK_NOTIFY + Jim_SetResultString(interp, "unlock_notify not available in this build", -1); + rc = JIM_ERR; +#else + if( objc!=2 && objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); + rc = JIM_ERR; + }else{ + void (*xNotify)(void **, int) = 0; + void *pNotifyArg = 0; + + if( pDb->pUnlockNotify ){ + Jim_DecrRefCount(interp, pDb->pUnlockNotify); + pDb->pUnlockNotify = 0; + } + + if( objc==3 ){ + xNotify = DbUnlockNotify; + pNotifyArg = (void *)pDb; + pDb->pUnlockNotify = objv[2]; + Jim_IncrRefCount(pDb->pUnlockNotify); + } + + if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){ + Jim_SetResultString(interp, sqlite3_errmsg(pDb->db), -1); + rc = JIM_ERR; + } + } +#endif + break; + } + + /* + ** $db update_hook ?script? + ** $db rollback_hook ?script? + */ + case DB_UPDATE_HOOK: + case DB_ROLLBACK_HOOK: { + + /* set ppHook to point at pUpdateHook or pRollbackHook, depending on + ** whether [$db update_hook] or [$db rollback_hook] was invoked. + */ + Jim_Obj **ppHook; + if( choice==DB_UPDATE_HOOK ){ + ppHook = &pDb->pUpdateHook; + }else{ + ppHook = &pDb->pRollbackHook; + } + + if( objc!=2 && objc!=3 ){ + Jim_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); + return JIM_ERR; + } + if( *ppHook ){ + Jim_SetResult(interp, *ppHook); + if( objc==3 ){ + Jim_DecrRefCount(interp, *ppHook); + *ppHook = 0; + } + } + if( objc==3 ){ + assert( !(*ppHook) ); + if( Jim_Length(objv[2])>0 ){ + *ppHook = objv[2]; + Jim_IncrRefCount(*ppHook); + } + } + + sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb); + sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb); + + break; + } + + /* $db version + ** + ** Return the version string for this database. + */ + case DB_VERSION: { + Jim_SetResultString(interp, sqlite3_libversion(), -1); + break; + } + + + } /* End of the SWITCH statement */ + return rc; +} + +/* +** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN? +** ?-create BOOLEAN? ?-nomutex BOOLEAN? +** +** This is the main Tcl command. When the "sqlite" Tcl command is +** invoked, this routine runs to process that command. +** +** The first argument, DBNAME, is an arbitrary name for a new +** database connection. This command creates a new command named +** DBNAME that is used to control that connection. The database +** connection is deleted when the DBNAME command is deleted. +** +** The second argument is the name of the database file. +** +*/ +static int DbMain(Jim_Interp *interp, int objc, Jim_Obj *const*objv){ + SqliteDb *p; + const char *pKey = 0; + int nKey = 0; + const char *zArg; + char *zErrMsg; + int i; + const char *zFile; + const char *zVfs = 0; + int flags; + + /* Not threading in Jim, so no mutexing is needed */ + flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX; + + if( objc==2 ){ + zArg = Jim_String(objv[1]); + if( strcmp(zArg,"-version")==0 ){ + Jim_SetResultString(interp, sqlite3_version, -1); + return JIM_OK; + } + if( strcmp(zArg,"-has-codec")==0 ){ +#ifdef SQLITE_HAS_CODEC + Jim_SetResultInt(interp, 1); +#else + Jim_SetResultInt(interp, 0); +#endif + return JIM_OK; + } + } + for(i=3; i+1db, flags, zVfs); + if( SQLITE_OK!=sqlite3_errcode(p->db) ){ + zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); + sqlite3_close(p->db); + p->db = 0; + } +#ifdef SQLITE_HAS_CODEC + if( p->db ){ + sqlite3_key(p->db, pKey, nKey); + } +#endif + if( p->db==0 ){ + Jim_SetResultString(interp, zErrMsg, -1); + Jim_Free((char*)p); + sqlite3_free(zErrMsg); + return JIM_ERR; + } + p->maxStmt = NUM_PREPARED_STMTS; + p->interp = interp; + zArg = Jim_String(objv[1]); + Jim_CreateCommand(interp, zArg, DbObjCmd, p, DbDeleteCmd); + return JIM_OK; +} + +/* +** Make sure we have a PACKAGE_VERSION macro defined. This will be +** defined automatically by the TEA makefile. But other makefiles +** do not define it. +*/ +#ifndef PACKAGE_VERSION +# define PACKAGE_VERSION SQLITE_VERSION +#endif + +#define EXTERN +/* +** Initialize this module. +** +** This Tcl module contains only a single new Tcl command named "sqlite". +** (Hence there is no namespace. There is no point in using a namespace +** if the extension only supplies one new name!) The "sqlite" command is +** used to open a new SQLite database. See the DbMain() routine above +** for additional information. +*/ +EXTERN int Jim_sqliteInit(Jim_Interp *interp){ + Jim_PackageProvideCheck(interp, "sqlite"); + Jim_CreateCommand(interp, "sqlite", DbMain, 0, 0); + return JIM_OK; +} diff -Nru jimtcl-0.79+dfsg0/sqlite3/Makefile jimtcl-0.81+dfsg0/sqlite3/Makefile --- jimtcl-0.79+dfsg0/sqlite3/Makefile 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/sqlite3/Makefile 2021-11-27 23:06:54.000000000 +0000 @@ -1,16 +1,16 @@ # Builds the full sqlite3 extension for Jim Tcl with the sqlite3 amalgamation -all: sqlite3.so +all: sqlite.so SQLITE3_OPTS := -DSQLITE_OMIT_LOAD_EXTENSION=1 -DSQLITE_THREADSAFE=0 -DSQLITE_DEFAULT_FILE_FORMAT=4 \ -DSQLITE_ENABLE_STAT3 -DSQLITE_ENABLE_LOCKING_STYLE=0 -DSQLITE_OMIT_INCRBLOB -sqlite3.so: jim-sqlite3.c sqlite3.c +sqlite.so: jim-sqlite.c sqlite3.c ./build-ext -Wall -o $@ -I.. -L.. $(SQLITE3_OPTS) $(BUILDOPTS) $^ clean: rm -f *.o *.so # Note that this will only work when not cross compiling -test: sqlite3.so - ../jimsh test-sqlite3.tcl +test: sqlite.so + ../jimsh test-sqlite.tcl diff -Nru jimtcl-0.79+dfsg0/sqlite3/README jimtcl-0.81+dfsg0/sqlite3/README --- jimtcl-0.79+dfsg0/sqlite3/README 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/sqlite3/README 2021-11-27 23:06:54.000000000 +0000 @@ -13,14 +13,14 @@ $ make -./build-ext -o sqlite3.so -I.. -L.. -DSQLITE_OMIT_LOAD_EXTENSION=1 ... jim-sqlite3.c sqlite3.c -Building sqlite3.so from jim-sqlite3.c sqlite3.c +./build-ext -o sqlite.so -I.. -L.. -DSQLITE_OMIT_LOAD_EXTENSION=1 ... jim-sqlite.c sqlite3.c +Building sqlite.so from jim-sqlite.c sqlite3.c Warning: libjim is static. Dynamic module may not work on some platforms. -Compile: jim-sqlite3.o +Compile: jim-sqlite.o Compile: sqlite3.o -Link: sqlite3.so +Link: sqlite.so Success! @@ -32,17 +32,17 @@ Installing ---------- -Copy sqlite3.so to your jim library directory, typically /usr/local/lib/jim or +Copy sqlite.so to your jim library directory, typically /usr/local/lib/jim or where $JIMLIB points to. Using ----- -In your Jim Tcl code, ensure that sqlite3.so is in a directory on $auto_path. +In your Jim Tcl code, ensure that sqlite.so is in a directory on $auto_path. Then: - package require sqlite3 + package require sqlite - sqlite3 db test.db + sqlite db test.db ...etc.. Documentation diff -Nru jimtcl-0.79+dfsg0/sqlite3/test-sqlite3.tcl jimtcl-0.81+dfsg0/sqlite3/test-sqlite3.tcl --- jimtcl-0.79+dfsg0/sqlite3/test-sqlite3.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/sqlite3/test-sqlite3.tcl 1970-01-01 00:00:00.000000000 +0000 @@ -1,51 +0,0 @@ -# A simple test of the "big" sqlite3 extension - -set auto_path [list . {*}$auto_path] - -package require sqlite3 - -# Create an in-memory database and add some data -sqlite3 db :memory: -db eval {CREATE TABLE history (type, time, value)} -foreach t [range 1 50] { - set temp [rand 100] - db eval {INSERT INTO history (type, time, value) VALUES ('temp', :t, :temp)} -} -foreach t [range 2 50 2] { - set v $([rand 200] / 10.0 + 5) - db eval {INSERT INTO history (type, time, value) VALUES ('voltage', :t, :v)} -} - -# Output some data in SVG format. -puts "\nSVG Example\n" - -set points {} -db eval {SELECT time,value FROM history - WHERE (time >= 10 and time <= 30) and type = 'voltage' - ORDER BY time DESC} row { - lappend points $row(time),$row(value) -} -puts "" - -# And tabular format with a self outer join -puts "\nTabular Self Outer Join Example\n" - -proc showrow {args} { - puts [format "%-12s %-12s %-12s" {*}$args] -} - -showrow Time Temp Voltage -showrow ---- ---- ------- -db eval {SELECT * FROM (SELECT time, value AS temp FROM history WHERE type = 'temp') AS A - LEFT OUTER JOIN (SELECT time, value AS voltage FROM history WHERE type = 'voltage') AS B - USING (time) - WHERE time >= 10 AND time <= 30 - ORDER BY time} row { - showrow $row(time) $row(temp) $row(voltage) -} -set maxtemp [db eval {SELECT max(value) FROM history WHERE type = 'temp'}] -set maxvolt [db eval {SELECT max(value) AS maxvolt FROM history WHERE type = 'voltage'}] -showrow ---- ---- ------- -showrow max $maxtemp $maxvolt - -db close diff -Nru jimtcl-0.79+dfsg0/sqlite3/test-sqlite.tcl jimtcl-0.81+dfsg0/sqlite3/test-sqlite.tcl --- jimtcl-0.79+dfsg0/sqlite3/test-sqlite.tcl 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/sqlite3/test-sqlite.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,51 @@ +# A simple test of the "big" sqlite extension + +set auto_path [list . {*}$auto_path] + +package require sqlite + +# Create an in-memory database and add some data +sqlite db :memory: +db eval {CREATE TABLE history (type, time, value)} +foreach t [range 1 50] { + set temp [rand 100] + db eval {INSERT INTO history (type, time, value) VALUES ('temp', :t, :temp)} +} +foreach t [range 2 50 2] { + set v $([rand 200] / 10.0 + 5) + db eval {INSERT INTO history (type, time, value) VALUES ('voltage', :t, :v)} +} + +# Output some data in SVG format. +puts "\nSVG Example\n" + +set points {} +db eval {SELECT time,value FROM history + WHERE (time >= 10 and time <= 30) and type = 'voltage' + ORDER BY time DESC} row { + lappend points $row(time),$row(value) +} +puts "" + +# And tabular format with a self outer join +puts "\nTabular Self Outer Join Example\n" + +proc showrow {args} { + puts [format "%-12s %-12s %-12s" {*}$args] +} + +showrow Time Temp Voltage +showrow ---- ---- ------- +db eval {SELECT * FROM (SELECT time, value AS temp FROM history WHERE type = 'temp') AS A + LEFT OUTER JOIN (SELECT time, value AS voltage FROM history WHERE type = 'voltage') AS B + USING (time) + WHERE time >= 10 AND time <= 30 + ORDER BY time} row { + showrow $row(time) $row(temp) $row(voltage) +} +set maxtemp [db eval {SELECT max(value) FROM history WHERE type = 'temp'}] +set maxvolt [db eval {SELECT max(value) AS maxvolt FROM history WHERE type = 'voltage'}] +showrow ---- ---- ------- +showrow max $maxtemp $maxvolt + +db close diff -Nru jimtcl-0.79+dfsg0/tclcompat.tcl jimtcl-0.81+dfsg0/tclcompat.tcl --- jimtcl-0.79+dfsg0/tclcompat.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tclcompat.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -181,72 +181,6 @@ return $pids } -# try/on/finally conceptually similar to Tcl 8.6 -# -# Usage: try ?catchopts? script ?onclause ...? ?finallyclause? -# -# Where: -# catchopts is: options for catch such as -nobreak, -signal -# onclause is: on codes {?resultvar? ?optsvar?} script -# codes is: a list of return codes (ok, error, etc. or integers), or * for any -# finallyclause is: finally script -proc try {args} { - set catchopts {} - while {[string match -* [lindex $args 0]]} { - set args [lassign $args opt] - if {$opt eq "--"} { - break - } - lappend catchopts $opt - } - if {[llength $args] == 0} { - return -code error {wrong # args: should be "try ?options? script ?argument ...?"} - } - set args [lassign $args script] - set code [catch -eval {*}$catchopts {uplevel 1 $script} msg opts] - - set handled 0 - - foreach {on codes vars script} $args { - switch -- $on \ - on { - if {!$handled && ($codes eq "*" || [info returncode $code] in $codes)} { - lassign $vars msgvar optsvar - if {$msgvar ne ""} { - upvar $msgvar hmsg - set hmsg $msg - } - if {$optsvar ne ""} { - upvar $optsvar hopts - set hopts $opts - } - # Override any body result - set code [catch {uplevel 1 $script} msg opts] - incr handled - } - } \ - finally { - set finalcode [catch {uplevel 1 $codes} finalmsg finalopts] - if {$finalcode} { - # Override any body or handler result - set code $finalcode - set msg $finalmsg - set opts $finalopts - } - break - } \ - default { - return -code error "try: expected 'on' or 'finally', got '$on'" - } - } - - if {$code} { - incr opts(-level) - return {*}$opts $msg - } - return $msg -} - # Generates an exception with the given code (ok, error, etc. or an integer) # and the given message proc throw {code {msg ""}} { diff -Nru jimtcl-0.79+dfsg0/Tcl_shipped.html jimtcl-0.81+dfsg0/Tcl_shipped.html --- jimtcl-0.79+dfsg0/Tcl_shipped.html 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/Tcl_shipped.html 2021-11-27 23:06:54.000000000 +0000 @@ -739,7 +739,7 @@

NAME

-

Jim Tcl v0.79 - +

Jim Tcl v0.81 - reference manual for the Jim Tcl scripting language

@@ -791,7 +791,7 @@ The core language engine is compatible with Tcl 8.5+, while implementing a significant subset of the Tcl 8.6 command set, plus additional features available only in Jim Tcl.

-

Some notable differences with Tcl 8.5/8.6 are:

+

Some notable differences with Tcl 8.5/8.6/8.7 are:

  1. @@ -880,6 +880,107 @@

    RECENT CHANGES

    +

    Changes between 0.80 and 0.81

    +
      +
    1. +

      +TIP 582, comments allowed in expressions +

      +
      2. +
    2. +

      +Many commands now accept "safe" integer expressions rather than simple integers: + loop, range, incr, string repeat, lrepeat, pack, unpack, rand +

      +
      3. +
    3. +

      +String and list indexes now accept integer expressions (STRING AND LIST INDEX SPECIFICATIONS) +

      +
      4. +
    4. +

      +loop can now omit the start value +

      +
      5. +
    5. +

      +Add the xtrace command for execution trace support +

      +
      6. +
    6. +

      +Add history keep +

      +
      7. +
    7. +

      +Add support for lsearch -index and lsearch -stride, the latter per TIP 351 +

      +
      8. +
    8. +

      +lsort -index now supports multiple indices +

      +
      9. +
    9. +

      +Add support for lsort -stride +

      +
      10. +
    10. +

      +open now supports POSIX-style access arguments +

      +
      11. +
    11. +

      +TIP 526, expr now only allows a single argument (unless --compat is enabled) +

      +
      12. +
    +
    +
    +

    Changes between 0.79 and 0.80

    +
      +
    1. +

      +regsub now fully supports \A +

      +
      2. +
    2. +

      +Add socket pty to create a pseudo-tty pair +

      +
      3. +
    3. +

      +Null characters (\x00) are now supported in variable and proc names +

      +
      4. +
    4. +

      +dictionaries and arrays now preserve insertion order, matching Tcl and the documentation +

      +
      5. +
    5. +

      +Add dict getwithdefault (and the alias dict getdef) per TIP 342 +

      +
      6. +
    6. +

      +Add string comparison operators (lt, gt, le, ge) per TIP 461 +

      +
      7. +
    7. +

      +Implement 0d radix prefix for decimal per TIP 472 +

      +
      8. +
    +
    +

    Changes between 0.78 and 0.79

    1. @@ -1713,25 +1814,40 @@

      - A simple integer, where 0 refers to the first element of the string + A simple integer, where 0 refers to the first element of the string or list.

      -integer+integer or +integerexpression
      +
      +

      + Any "safe" expression that evaluates to an integer. A "safe" expression does not perform + variable or command subsitution, but is otherwise like a normal expression + (see EXPRESSIONS). +

      +
      -integer-integer +

      - The sum or difference of the two integers. e.g. 2+3 refers to the 5th element. - This is useful when used with (e.g.) $i+1 rather than the more verbose - [expr {$i+1}] + For example 1+2*3 is valid integer expression, but {$x*2-1} is not. + But note that it is possible to use an unbraced expression to allow the Tcl interpreter + to expand variables and commands before being parsed as an integer expression.

      -end + +
      +
      +

      + e.g. string repeat a $x*2-1 +

      +
      +
      +end

      @@ -1739,11 +1855,20 @@

      -end-integer +end-integer +
      +
      +end-integerexpression +
      +
      +end+integerexpression

      - The nth-from-last element of the string or list. + The nth-from-last element of the string or list. Again, a "safe" integer expression + may be used in place of a simple integer. end-3 or end-3+2*$n. Normally it only makes + sense to use the end- form, but if the integer expression is negative, the end+ form + may be used.

    @@ -1842,9 +1967,12 @@

    White space may be used between the operands and operators and parentheses; it is ignored by the expression processor. Where possible, operands are interpreted as integer values.

    -

    Integer values may be specified in decimal (the normal case) or in -hexadecimal (if the first two characters of the operand are 0x). -Note that Jim Tcl does not treat numbers with leading zeros as octal.

    +

    Comments are allowed in expressions, beginning with the # character +and continuing until the end of line or end of expression.

    +

    Integer values are interpreted as decimal, binary, octal or +hexadecimal if prepended with 0d, 0b, 0o or 0x +respectively. Otherwise they are interpreted as decimal by default. +(Jim Tcl does not interpret numbers with leading zeros as octal.)

    If an operand does not have one of the integer formats given above, then it is treated as a floating-point number if that is possible. Floating-point numbers may be specified in any of the @@ -2032,6 +2160,17 @@

    +lt gt le ge +
    +
    +

    + Boolean less, greater, less than or equal, and greater than or equal. + Each operator produces 1 if the condition is true, 0 otherwise. + These operators differ from the above in that they use string comparison + for all operands, including numeric. +

    +
    +
    == !=
    @@ -2288,7 +2427,7 @@

    REGULAR EXPRESSIONS

    -

    Tcl provides two commands that support string matching using regular +

    Jim Tcl provides two commands that support string matching using regular expressions, regexp and regsub, as well as switch -regexp and lsearch -regexp.

    Regular expressions may be implemented one of two ways. Either using the system’s C library @@ -2336,7 +2475,7 @@

  2. -Supported constraint escapes: \m = \< = start of word, \M = \> = end of word +Supported constraint escapes: \m = \< = start of word, \M = \> = end of word, \A = start of string, \Z = end of string

  3. @@ -2346,22 +2485,22 @@

  4. -Partially supported constraint escapes: \A = start of string, \Z = end of string +Support for the ? non-greedy quantifier. e.g. *?

  5. -Support for the ? non-greedy quantifier. e.g. *? +Support for non-capturing parentheses (?:…)

  6. -Support for non-capturing parentheses (?:…) +Jim Tcl considers that both patterns and strings end at a null character (\x00)

  7. -Jim Tcl considers that both patterns and strings end at a null character (\x00) +Jim Tcl does not support back references. e.g. \1

@@ -2369,6 +2508,56 @@
+

STRING MATCHING

+
+

A number of commands in Jim support C-shell style "glob matching", including +string match, switch -glob, array names and others. This form of string matching +works as follows:

+

A test occurs where a string is matched against a pattern. The match is considered +successful if the contents of string and pattern are identical except that the +following special sequences may appear in pattern:

+
+
+* +
+
+

+ Matches any sequence of characters in string, including an empty string. +

+
+
+? +
+
+

+ Matches any single character in string. +

+
+
+[chars] +
+
+

+ Matches any character in the set given by chars. + If a sequence of the form x-y appears in chars, + then any character between x and y, inclusive, + will match. +

+
+
+\x +
+
+

+ Matches the single character x. This provides a way of + avoiding the special interpretation of the characters \*?[] + in pattern. +

+
+
+
+
+

COMMAND RESULTS

Each command produces two results: a code and a string. The @@ -2936,9 +3125,9 @@ is still available to embed UTF-8 sequences.

Jim Tcl supports all currently defined unicode codepoints. That is 21 bits, up to +U+1FFFFF.

-

String Matching

-

Commands such as string match, lsearch -glob, array names and others use string -pattern matching rules. These commands support UTF-8. For example:

+

String Matching

+

Commands such as string match, lsearch -glob, array names and others use +STRING MATCHING rules. These commands support UTF-8. For example:

  string match a\[\ua0-\ubf\]b "a\u00a3b"
@@ -3196,8 +3385,8 @@

vwait

wait

while

+

xtrace

zlib

-

@@ -3244,10 +3433,10 @@

apply

apply lambdaExpr ?arg1 arg2 ...?

The command apply provides for anonymous procedure calls, -similar to lambda, but without command name being created, even temporarily.

-

The function lambdaExpr is a two element list {args body} -or a three element list {args body namespace}. The first element -args specifies the formal arguments, in the same form as the proc and lambda commands.

+similar to lambda, but without a command name being created, even temporarily.

+

The function lambdaExpr is a two element list, {args body} +or a three element list, {args body namespace}. The first element +args specifies the formal arguments in the same form as the proc and lambda commands.

array

@@ -3264,7 +3453,7 @@

- Returns 1 if arrayName is an array variable, 0 if there is + Returns 1 if arrayName is an array variable, 0 if there is no variable by that name.

@@ -3274,13 +3463,13 @@

Returns a list containing pairs of elements. The first - element in each pair is the name of an element in arrayName + element in each pair is the name of an element in arrayName and the second element of each pair is the value of the array element. The order of the pairs is undefined. If - pattern is not specified, then all of the elements of the - array are included in the result. If pattern is specified, - then only those elements whose names match pattern (using - the matching rules of string match) are included. If arrayName + pattern is not specified, then all of the elements of the + array are included in the result. If pattern is specified, + then only those elements whose names match pattern (using + STRING MATCHING rules) are included. If arrayName isn’t the name of an array variable, or if the array contains no elements, then an empty list is returned.

@@ -3291,12 +3480,12 @@

Returns a list containing the names of all of the elements - in the array that match pattern. If pattern is omitted then + in the array that match pattern. If pattern is omitted then the command returns all of the element names in the array. - If pattern is specified, then only those elements whose - names match pattern (using the matching rules of string - match) are included. If there are no (matching) elements - in the array, or if arrayName isn’t the name of an array + If pattern is specified, then only those elements whose + names match pattern (using STRING MATCHING rules) + are included. If there are no (matching) elements + in the array, or if arrayName isn’t the name of an array variable, then an empty string is returned.

@@ -3305,13 +3494,13 @@

- Sets the values of one or more elements in arrayName. list + Sets the values of one or more elements in arrayName. list must have a form like that returned by array get, consisting of an even number of elements. Each odd-numbered element in list is treated as an element name within arrayName, and the following element in list is used as a new value for - that array element. If the variable arrayName does not - already exist and list is empty, arrayName is created with + that array element. If the variable arrayName does not + already exist and list is empty, arrayName is created with an empty array value.

@@ -3320,7 +3509,7 @@

- Returns the number of elements in the array. If arrayName + Returns the number of elements in the array. If arrayName isn’t the name of an array then 0 is returned.

@@ -3329,11 +3518,11 @@

- Unsets all of the elements in the array that match pattern - (using the matching rules of string match). If arrayName + Unsets all of the elements in the array that match pattern + (using STRING MATCHING rules). If arrayName isn’t the name of an array variable or there are no matching - elements in the array, no error will be raised. If pattern - is omitted and arrayName is an array variable, then the + elements in the array, no error will be raised. If pattern + is omitted and arrayName is an array variable, then the command unsets the entire array. The command always returns an empty string.

@@ -3459,7 +3648,7 @@

If boolean is true, processing is performed in UTC. - If boolean is false (the default), processing is performeed in the local time zone. + If boolean is false (the default), processing is performed in the local time zone.

@@ -3473,6 +3662,8 @@

+

NOTE Some systems such as 32-bit Linux have only a 32-bit time_t, and are therefore not year 2038 +compliant.

close

@@ -3579,14 +3770,31 @@

+dict getdef dictionary ?key ...? key default +
+
+

+ Alias for dict getwithdefault. +

+
+
+dict getwithdefault dictionary ?key ...? key default +
+
+

+ Similar to dict get except if no value exists in the dictionary for the + give key(s), returns default instead. +

+
+
dict keys dictionary ?pattern?

Returns a list of the keys in the dictionary. - If pattern is specified, then only those keys whose - names match pattern (using the matching rules of string - match) are included. + If pattern is specified, then only those keys whose + names match pattern (using STRING MATCHING rules) + are included.

@@ -4447,7 +4655,7 @@

Increment the value stored in the variable whose name is varName. The value of the variable must be integral.

If increment is supplied then its value (which must be an -integer) is added to the value of variable varName; otherwise +integer expression) is added to the value of variable varName; otherwise 1 is added to varName.

The new value is stored as a decimal string in variable varName and also returned as result.

@@ -4511,8 +4719,7 @@ Tcl commands, including both the built-in commands written in C and the command procedures defined using the proc command. If pattern is specified, only those names matching pattern - are returned. Matching is determined using the same rules as for - string match. + (using STRING MATCHING rules) are returned.

@@ -4564,8 +4771,7 @@ If pattern isn’t specified, returns a list of all the names of currently-defined global variables. If pattern is specified, only those names matching pattern - are returned. Matching is determined using the same rules as for - string match. + (using STRING MATCHING rules) are returned.

@@ -4603,8 +4809,8 @@ of currently-defined local variables, including arguments to the current procedure, if any. Variables defined with the global and upvar commands will not be returned. If pattern is - specified, only those names matching pattern are returned. - Matching is determined using the same rules as for string match. + specified, only those names matching pattern + (using STRING MATCHING rules) are returned.

@@ -4625,8 +4831,7 @@ If pattern isn’t specified, returns a list of all the names of Tcl command procedures. If pattern is specified, only those names matching pattern - are returned. Matching is determined using the same rules as for - string match. + (using STRING MATCHING rules) are returned.

@@ -4709,8 +4914,7 @@ returns a list of all the names of currently-visible variables, including both locals and currently-visible globals. If pattern is specified, only those names matching pattern - are returned. Matching is determined using the same rules as for - string match. + (using STRING MATCHING rules) are returned.

@@ -4808,12 +5012,12 @@

local

local cmd ?arg...?

First, local evaluates cmd with the given arguments. The return value must -be the name of an existing command, which is marked as having local scope. +be the name of an existing command, which is then marked as having local scope. This means that when the current procedure exits, the specified command is deleted. This can be useful with lambda, local procedures or to automatically close a filehandle.

-

In addition, if a command already exists with the same name, -the existing command will be kept rather than deleted, and may be called +

In addition, if a the command already exists with the same name, +the existing command will be kept rather than being deleted, and may be called via upcall. The previous command will be restored when the current procedure exits. See upcall for more details.

In this example, a local procedure is created. Note that the procedure @@ -4845,19 +5049,23 @@ ... }

+

Also see defer as another mechanism for cleaning up at the end of a procedure.

loop

-

loop var first limit ?incr? body

+

loop var ?first? limit ?incr? body

Similar to for except simpler and possibly more efficient. -With a positive increment, equivalent to:

+If incr is positive, the effect is, equivalent to:

    for {set var $first} {$var < $limit} {incr var $incr} $body
-

If incr is not specified, 1 is used. +

While if incr is negative, the count is downwards.

+

If first is not specified, 0 is used. +If incr is not specified, 1 is used. Note that setting the loop variable inside the loop does not affect the loop count.

+

first, limit and incr may be any integer expression.

lindex

@@ -4918,8 +5126,7 @@

llength

llength list

-

Treats list as a list and returns a decimal string giving -the number of elements in it.

+

Treats list as a list and returns the number of elements in that list.

lset

@@ -4928,26 +5135,26 @@

The lset command accepts a parameter, varName, which it interprets as the name of a variable containing a Tcl list. It also accepts zero or more indices into the list. Finally, it accepts a new value -for an element of varName. If no indices are presented, the command +for an element of varName. If no indices are presented, the command takes the form:

    lset varName newValue

In this case, newValue replaces the old value of the variable -varName.

+varName.

When presented with a single index, the lset command -treats the content of the varName variable as a Tcl list. It addresses +treats the content of the varName variable as a Tcl list. It addresses the index’th element in it (0 refers to the first element of the list). When interpreting the list, lset observes the same rules concerning braces and quotes and backslashes as the Tcl command interpreter; however, variable substitution and command substitution do not occur. The command constructs a new list in which the designated element is replaced with newValue. This new list is -stored in the variable varName, and is also the return value from +stored in the variable varName, and is also the return value from the lset command.

If index is negative or greater than or equal to the number of -elements in $varName, then an error occurs.

+elements in $varName, then an error occurs.

See STRING AND LIST INDEX SPECIFICATIONS for all allowed forms for index.

If additional index arguments are supplied, then each argument is used in turn to address an element within a sublist designated by @@ -5068,8 +5275,8 @@

- pattern is a glob-style pattern which is matched against each list element using the same - rules as the string match command. + pattern is a glob-style pattern which is matched against each list element using + STRING MATCHING rules.

@@ -5078,7 +5285,7 @@

pattern is treated as a regular expression and matched against each list element using - the rules described by regexp. + REGULAR EXPRESSIONS rules.

@@ -5142,29 +5349,149 @@ Causes comparisons to be handled in a case-insensitive manner.

+
+-index indexList +
+
+

+ This option is designed for use when searching within nested lists. The + indexList gives a path of indices (much as might be used with + the lindex or lset commands) within each element to allow the location + of the term being matched against. +

+
+
+-stride strideLength +
+
+

+ If this option is specified, the list is treated as consisting of + groups of strideLength elements and the groups are searched by + either their first element or, if the -index option is used, + by the element within each group given by the first index passed to + -index (which is then ignored by -index). The resulting + index always points to the first element in a group. +

+
+
+ +
+
+

+ The list length must be an integer multiple of strideLength, which + in turn must be at least 1. A strideLength of 1 is the default and + indicates no grouping. +

+

lsort

-

lsort ?-index listindex? ?-nocase|-integer|-real|-command cmdname? ?-unique? ?-decreasing|-increasing? list

+

lsort ?options? list

Sort the elements of list, returning a new list in sorted order. By default, ASCII (or UTF-8) sorting is used, with the result in increasing order.

-

If -nocase is specified, comparisons are case-insensitive.

-

If -integer is specified, numeric sorting is used.

-

If -real is specified, floating point number sorting is used.

-

If -command cmdname is specified, cmdname is treated as a command -name. For each comparison, cmdname $value1 $value2 is called which -should compare the values and return an integer less than, equal -to, or greater than zero if the $value1 is to be considered less -than, equal to, or greater than $value2, respectively.

-

If -decreasing is specified, the resulting list is in the opposite -order to what it would be otherwise. -increasing is the default.

-

If -unique is specified, then only the last set of duplicate elements found in the list will be retained. -Note that duplicates are determined relative to the comparison used in the sort. Thus if -index 0 is used, -{1 a} and {1 b} would be considered duplicates and only the second element, {1 b}, would be retained.

-

If -index listindex is specified, each element of the list is treated as a list and -the given index is extracted from the list for comparison. The list index may -be any valid list index, such as 1, end or end-2.

+

Note that only one sort type may be selected with -integer, -real, -nocase or -command +with last option being used.

+
+
+-integer +
+
+

+ Sort using numeric (integer) comparison. +

+
+
+-real +
+
+

+ Sort using floating point comparison. +

+
+
+-nocase +
+
+

+ Sort using using string comparison without regard for case. +

+
+
+-command cmdname +
+
+

+ cmdname is treated as a command name. For each comparison, + cmdname $value1 $value2 is called which + should compare the values and return an integer less than, equal + to, or greater than zero if the $value1 is to be considered less + than, equal to, or greater than $value2, respectively. +

+
+
+-increasing +
+
+

+ The resulting list is in ascending order, from smallest/lowest to largest/highest. + This is the default and does not need to be specified. +

+
+
+-decreasing +
+
+

+ The resulting list is in the opposite order to what it would be otherwise. +

+
+
+-unique +
+
+

+ Only the last set of duplicate elements found in the list will + be retained. Note that duplicates are determined relative to the + comparison used in the sort. Thus if -index 0 is used, {1 a} and + {1 b} would be considered duplicates and only the second element, + {1 b}, would be retained. +

+
+
+-index indexList +
+
+

+ This option is designed for use when sorting nested lists. The + indexList gives a path of indices (much as might be used with + the lindex or lset commands) within each element to specify the + value to be used for comparison. +

+
+
+-stride strideLength +
+
+

+ If this option is specified, the list is treated as consisting of + groups of strideLength elements and the groups are sorted by + either their first element or, if the -index option is used, + by the element within each group given by the first index passed to + -index (which is then ignored by -index). The resulting list + is once again a flat list. +

+
+
+ +
+
+

+ The list length must be an integer multiple of strideLength, which + in turn must be at least 2. +

+
+

defer

@@ -5248,6 +5575,87 @@

access defaults to r.

+

Additionally, if POSIX mode is supported by the underlying system, +then access may insted of consistent of a list of any of the following +flags, all of which have the standard POSIX meanings. In this case, +the first flag must be one of RDONLY, WRONLY or RDWR.

+
+
+RDONLY +
+
+

+ Open the file for reading only. +

+
+
+WRONLY +
+
+

+ Open the file for writing only. +

+
+
+RDWR +
+
+

+ Open the file for both reading and writing. +

+
+
+APPEND +
+
+

+ Set the file pointer to the end of the file prior to each write. +

+
+
+BINARY +
+
+

+ Ignored. +

+
+
+CREAT +
+
+

+ Create the file if it does not already exist (without this flag + it is an error for the file not to exist). +

+
+
+EXCL +
+
+

+ If CREAT is also specified, an error is returned if the file + already exists. +

+
+
+NOCTTY +
+
+

+ If the file is a terminal device, this flag prevents the file + from becoming the controlling terminal of the process. +

+
+
+TRUNC +
+
+

+ If the file exists it is truncated to zero length. +

+
+

If a file is opened for both reading and writing, then seek must be invoked between a read and a write, or vice versa.

If the first character of fileName is "|" then the remaining @@ -5269,10 +5677,11 @@

package

package provide name ?version?

Indicates that the current script provides the package named name. -If no version is specified, 1.0 is used.

-

Any script which provides a package may include this statement +Note: The supplied version is ignored. All packages are registered as version 1.0 +(it is simply accepted for compatibility purposes).

+

Any script that provides a package may include this statement as the first statement, although it is not required.

-

package require name ?version?*

+

package require name ?version?

Searches for the package with the given name by examining each path in $::auto_path and trying to load $path/$name.so as a dynamic extension, or $path/$name.tcl as a script package.

@@ -5282,6 +5691,8 @@ otherwise if $name.tcl exists it is loaded with the source command.

If load or source fails, package require will fail immediately. No further attempt will be made to locate the file.

+

package names

+

Returns a list of all known/loaded packages, including internal packages.

pid

@@ -5302,7 +5713,7 @@ Tcl interpreter. args specifies the formal arguments to the procedure. If specified, statics, declares static variables which are bound to the procedure.

-

See <<_procedures,PROCEDURES> for detailed information about Tcl procedures.

+

See PROCEDURES for detailed information about Tcl procedures.

The proc command returns name (which is useful with local).

When a procedure is invoked, the procedure’s return value is the value specified in a return command. If the procedure doesn’t @@ -5370,6 +5781,7 @@ . range 7 4 -2 7 5

+

Integer parameters may be any integer expression.

read

@@ -5377,6 +5789,8 @@

fileId read ?-nonewline?

read fileId numBytes

fileId read numBytes

+

read ?-pending? fileId

+

fileId read ?-pending?

In the first form, all of the remaining bytes are read from the file given by fileId; they are returned as the result of the command. If the -nonewline switch is specified then the last @@ -5385,6 +5799,19 @@ exactly this many bytes will be read and returned, unless there are fewer than numBytes bytes left in the file; in this case, all the remaining bytes are returned.

+

The third form is currently only useful with SSL sockets. It reads at least 1 byte +and then any additional data that is buffered. This allows for use in an event handler. +e.g.

+
+
+
    $sock readable {
+        set buf [$sock read -pending]
+    }
+
+

This is necessary because otherwise pending data may be buffered, but +the underlying socket will not be marked readable. This featured is not +currently supported for regular sockets, and so these sockets must be +set to unbufferred ($sock buffering false) to work in an event loop.

fileId must be stdin or the return value from a previous call to open; it must refer to a file that was opened for reading.

@@ -5432,9 +5859,9 @@ Use newline-sensitive matching. By default, newline is a completely ordinary character with no special meaning in either REs or strings. With this flag, [ bracket expressions - and . never match newline, an anchor matches the null + and . never match newline, an anchor matches the empty string after any newline in the string in addition to its normal - function, and the $ anchor matches the null string before any + function, and the $ anchor matches the empty string before any newline in the string in addition to its normal function.

@@ -5559,9 +5986,9 @@ Use newline-sensitive matching. By default, newline is a completely ordinary character with no special meaning in either REs or strings. With this flag, [ bracket expressions - and . never match newline, an anchor matches the null + and . never match newline, an anchor matches the empty string after any newline in the string in addition to its normal - function, and the $ anchor matches the null string before any + function, and the $ anchor matches the empty string before any newline in the string in addition to its normal function.

@@ -6233,59 +6660,10 @@

- See if pattern matches string; return 1 if it does, 0 - if it doesn’t. Matching is done in a fashion similar to that - used by the C-shell. For the two strings to match, their contents - must be identical except that the following special sequences - may appear in pattern: -

-
-
-* -
-
-

- Matches any sequence of characters in string, - including a null string. -

-
-
-? -
-
-

- Matches any single character in string. -

-
-
-[chars] -
-
-

- Matches any character in the set given by chars. - If a sequence of the form x-y appears in chars, - then any character between x and y, inclusive, - will match. -

-
-
-\x -
-
-

- Matches the single character x. This provides a way of - avoiding the special interpretation of the characters \*?[] - in pattern. -

-
-
-
-
- -
-
-

- Performs a case-insensitive comparison if -nocase is specified. + See if pattern matches string according to + STRING MATCHING rules + ; return 1 if it does, 0 + if it doesn’t. The match is performed in a case-insensitive manner if -nocase is specified.

@@ -6469,8 +6847,7 @@

When matching string to the patterns, use glob-style - matching (i.e. the same as implemented by the string - match command). + STRING MATCHING rules.

@@ -6478,9 +6855,8 @@

- When matching string to the patterns, use regular - expression matching (i.e. the same as implemented - by the regexp command). + When matching string to the patterns, use + REGULAR EXPRESSIONS rules.

@@ -6804,6 +7180,24 @@ termination of the while command.

The while command always returns an empty string.

+
+

xtrace

+

xtrace command

+

Install an execution trace callback command. This is useful for implementing a debugger +or tracing tool. On each command invocation, the given command is invoked as:

+
+
+
    command proc|cmd filename line result command arglist
+
+

proc or cmd indicates whether a command or a proc body is being executed. +filename and line indicate the location where the command was invoked. +result is the current interpreter result (from the previous command). +command and arglist indicate the command being executed.

+

While the callback is executing, any further execution traces are temporarily disabled. +If the callback returns JIM_OK or JIM_RETURN, the execution trace is reinstalled. Otherwise +the execution trace is removed.

+

If xtrace is called with an empty argument (""), any existing callback is removed.

+
@@ -6987,11 +7381,11 @@

-$handle read ?-nonewline? ?len? +$handle read ?-nonewline|-pending|len?'

- Read and return bytes from the stream. To eof if no len. + Read and return bytes from the stream. To eof if no len. See read.

@@ -7068,7 +7462,7 @@

If no arguments are given, returns a dictionary containing the tty settings for the stream. If arguments are given, they must either be a dictionary, or setting value ... - Abbrevations are supported for both settings and values, so the following is acceptable: + Abbreviations are supported for both settings and values, so the following is acceptable: $f tty parity e input c out raw. Only available on platforms that support termios(3). Supported settings are:

@@ -7158,11 +7552,15 @@
-$handle ssl ?-server cert priv? +$handle ssl ?-server cert ?key?|-sni servername?

Upgrades the stream to a SSL/TLS session and returns the handle. + If -server is specified, either both the certificate and private key files + must be specified, or a single file must be specified containing both. + If -server is not specified, the connection is a client connection. In this case + -sni may be specified if required to set the Server Name Indication.

@@ -7439,6 +7837,15 @@ a list of two channels: {s1 s2}. These channels are both readable and writable.

+
+socket pty +
+
+

+ A pseudo-tty pair (see openpty(3)). Like pipe, this command returns + a list of two channels: {master slave}. These channels are both readable and writable. +

+

This command creates a socket connected (client) or bound (server) to the given address.

@@ -7606,7 +8013,7 @@

Decompresses a raw, Deflate-compressed stream. When the uncompressed data size is known and specified, memory - allocation is more efficient. Otherwise, decomperssion is chunked and therefore slower. + allocation is more efficient. Otherwise, decompression is chunked and therefore slower.

@@ -7920,6 +8327,14 @@

+history keep ?count? +
+
+

+ Set or return the maximum history size. Defaults to 100. +

+
+
history save filename
@@ -8037,7 +8452,7 @@

Creates and returns a new interpreter object (command). - The created interpeter contains any built-in commands along with static extensions, + The created interpreter contains any built-in commands along with static extensions, but does not include any dynamically loaded commands (package require, load). These must be reloaded in the child interpreter if required.

@@ -8047,7 +8462,7 @@

- Deletes the interpeter object. + Deletes the interpreter object.

diff -Nru jimtcl-0.79+dfsg0/tcltest.tcl jimtcl-0.81+dfsg0/tcltest.tcl --- jimtcl-0.79+dfsg0/tcltest.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tcltest.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -4,15 +4,23 @@ set testinfo(verbose) 0 set testinfo(numpass) 0 set testinfo(stoponerror) 0 +set testinfo(template) 0 set testinfo(numfail) 0 set testinfo(numskip) 0 set testinfo(numtests) 0 set testinfo(reported) 0 set testinfo(failed) {} +set testinfo(source) [file tail $::argv0] +# -verbose or $testverbose show OK/ERR of individual tests if {[lsearch $argv "-verbose"] >= 0 || [info exists env(testverbose)]} { incr testinfo(verbose) } +# -template causes failed tests to output a template test that would succeed +if {[lsearch $argv "-template"] >= 0} { + incr testinfo(template) +} +# -stoponerror or $stoponerror stops on the first failed test if {[lsearch $argv "-stoponerror"] >= 0 || [info exists env(stoponerror)]} { incr testinfo(stoponerror) } @@ -53,8 +61,15 @@ error "Unknown needs type: $type" } +# Simplify setting constraints for whether commands exist +proc testCmdConstraints {args} { + foreach cmd $args { + testConstraint $cmd [expr {[info commands $cmd] ne {}}] + } +} + proc skiptest {{msg {}}} { - puts [format "%16s: --- skipped$msg" $::argv0] + puts [format "%16s: --- skipped$msg" $::testinfo(source)] exit 0 } @@ -137,7 +152,7 @@ proc script_source {script} { lassign [info source $script] f l if {$f ne ""} { - puts "At : $f:$l" + puts "$f:$l:Error test failure" return \t$f:$l } } @@ -145,7 +160,7 @@ proc error_source {} { lassign [info stacktrace] p f l if {$f ne ""} { - puts "At : $f:$l" + puts "$f:$l:Error test failure" return \t$f:$l } } @@ -154,7 +169,7 @@ if {[catch { package require $name }]} { - puts [format "%16s: --- skipped" $::argv0] + puts [format "%16s: --- skipped" $::testinfo(source)] exit 0 } } @@ -180,9 +195,25 @@ return $x } +# Takes a stacktrace and applies [file tail] to the filenames. +# This allows stacktrace tests to be run from a directory other than the source directory. +proc basename-stacktrace {stacktrace} { + set result {} + foreach {p f l} $stacktrace { + lappend result $p [file tail $f] $l + } + return $result +} + +# Takes a list of {filename line} and returns {basename line} +proc basename-source {list} { + list [file tail [lindex $list 0]] [lindex $list 1] +} + # Note: We don't support -output or -errorOutput yet proc test {id descr args} { - set a [dict create -returnCodes {ok return} -match exact -result {} -constraints {} -body {} -setup {} -cleanup {}] + set default [dict create -returnCodes {ok return} -match exact -result {} -constraints {} -body {} -setup {} -cleanup {}] + set a $default if {[lindex $args 0] ni [dict keys $a]} { if {[llength $args] == 2} { lassign $args body result constraints @@ -225,8 +256,10 @@ if {[info return $rc] ni $a(-returnCodes) && $rc ni $a(-returnCodes)} { set ok 0 - set expected "rc=$a(-returnCodes) result=$a(-result)" - set result "rc=[info return $rc] result=$result" + set expected "rc=[list $a(-returnCodes)] result=[list $a(-result)]" + set actual "rc=[info return $rc] result=[list $result]" + # Now for the template, update -returnCodes + set a(-returnCodes) [info return $rc] } else { if {$a(-match) eq "exact"} { set ok [string equal $a(-result) $result] @@ -237,7 +270,8 @@ } else { return -code error "$id: unknown match type: $a(-match)" } - set expected $a(-result) + set actual [list $result] + set expected [list $a(-result)] } if {$ok} { @@ -257,9 +291,23 @@ } else { set source [error_source] } - puts "Expected: '$expected'" - puts "Got : '$result'" + puts "Expected: $expected" + puts "Got : $actual" puts "" + if {$::testinfo(template)} { + # We can't really do -match glob|regexp so + # just store the result as-is for -match exact + set a(-result) $result + + set template [list test $id $descr] + foreach key {-constraints -setup -body -returnCodes -match -result -cleanup} { + if {$a($key) ne $default($key)} { + lappend template $key $a($key) + } + } + puts "### template" + puts $template\n + } incr ::testinfo(numfail) lappend ::testinfo(failed) [list $id $descr $source $expected $result] if {$::testinfo(stoponerror)} { @@ -279,9 +327,9 @@ incr ::testinfo(reported) if {$::testinfo(verbose)} { - puts -nonewline "\n$::argv0" + puts -nonewline "\n$::testinfo(source)" } else { - puts -nonewline [format "%16s" $::argv0] + puts -nonewline [format "%16s" $::testinfo(source)] } puts [format ": Total %5d Passed %5d Skipped %5d Failed %5d" \ $::testinfo(numtests) $::testinfo(numpass) $::testinfo(numskip) $::testinfo(numfail)] diff -Nru jimtcl-0.79+dfsg0/test-bootstrap-jim jimtcl-0.81+dfsg0/test-bootstrap-jim --- jimtcl-0.79+dfsg0/test-bootstrap-jim 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/test-bootstrap-jim 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,10 @@ +#!/bin/sh + +set -e +echo "Building bootstrap jimsh" +./make-bootstrap-jim >jimsh_bootstrap.c +${CC:-cc} -o jimsh_bootstrap jimsh_bootstrap.c +echo "Testing bootstrap jimsh" +( cd tests; ../jimsh_bootstrap runall.tcl ) +echo "All tests passed" +rm jimsh_bootstrap jimsh_bootstrap.c diff -Nru jimtcl-0.79+dfsg0/tests/aio.test jimtcl-0.81+dfsg0/tests/aio.test --- jimtcl-0.79+dfsg0/tests/aio.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/aio.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,159 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +testCmdConstraints socket +testConstraint posixaio [expr {$tcl_platform(platform) eq {unix} && !$tcl_platform(bootstrap)}] + +# Create and open in binary mode for compatibility between Windows and Unix +set f [open testdata.in wb] +$f puts test-data +$f close +set f [open testdata.in rb] + +defer { + $f close + file delete testdata.in +} + +test aio-1.1 {seek usage} -body { + $f seek +} -returnCodes error -match glob -result {wrong # args: should be "* seek offset ?start|current|end"} + +test aio-1.2 {seek start} -body { + $f seek 2 + $f tell +} -result {2} + +test aio-1.3 {seek start} -body { + $f seek 4 start + $f tell +} -result {4} + +test aio-1.4 {read after seek} -body { + set c [$f read 1] + list $c [$f tell] +} -result {- 5} + +test aio-1.5 {seek backwards} -body { + $f seek -2 current + set c [$f read 1] + list $c [$f tell] +} -result {t 4} + +test aio-1.6 {seek from end} -body { + $f seek -2 end + set c [$f read 2] + list $c [$f tell] +} -result [list "a\n" 10] + +test aio-1.7 {seek usage} -body { + $f seek 4 bad +} -returnCodes error -match glob -result {wrong # args: should be "* seek offset ?start|current|end"} + +test aio-1.8 {seek usage} -body { + $f seek badint +} -returnCodes error -match glob -result {expected integer but got "badint"} + +test aio-1.9 {seek bad pos} -body { + $f seek -20 +} -returnCodes error -match glob -result {testdata.in: Invalid argument} + +test aio-2.1 {read usage} -body { + $f read -nonoption +} -returnCodes error -result {bad option "-nonoption": must be -nonewline, or -pending} + +test aio-2.2 {read usage} -body { + $f read badint +} -returnCodes error -result {expected integer but got "badint"} + +test aio-2.3 {read -ve len} -body { + $f read " -20" +} -returnCodes error -result {invalid parameter: negative len} + +test aio-2.4 {read too many args} -body { + $f read 20 extra +} -returnCodes error -match glob -result {wrong # args: should be "* read ?-nonewline|-pending|len?"} + +test aio-2.5 {read -pending on non-ssl} -body { + $f read -pending +} -returnCodes error -result {-pending not supported on this connection type} + +test aio-3.1 {copy to invalid fh} -body { + $f copy lambda +} -returnCodes error -result {Not a filehandle: "lambda"} + +test aio-3.2 {copy bad length} -body { + $f copy stdout invalid +} -returnCodes error -result {expected integer but got "invalid"} + +set badvar a + +test aio-4.1 {gets invalid var} -body { + $f gets badvar(abc) +} -returnCodes error -result {can't set "badvar(abc)": variable isn't array} + +test aio-5.1 {puts usage} -body { + stdout puts -badopt abc +} -returnCodes error -result {wrong # args: should be "stdout puts ?-nonewline? str"} + +test aio-6.1 {eof} { + $f seek 0 + $f eof +} {0} + +test aio-6.2 {eof} { + # eof won't trigger until we try to read + $f seek 0 end + $f eof +} {0} + +test aio-6.3 {eof} { + $f read 1 + $f eof +} {1} + +test aio-7.1 {close args} -constraints socket -body { + $f close badopt +} -returnCodes error -result {bad option "badopt": must be -nodelete, r, or w} + +test aio-7.2 {close w on non-socket} -constraints socket -body { + $f close w +} -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} + +test aio-7.3 {close -nodelete on non-socket} -constraints socket -body { + $f close -nodelete +} -returnCodes error -result {not supported} + +test aio-8.1 {filename} { + $f filename +} testdata.in + +test aio-9.1 {open: posix modes} -constraints posixaio -body { + set in [open testdata.in RDONLY] + set buf [$in gets] + $in close + set buf +} -result {test-data} + +test aio-9.2 {open: posix modes, bad modes} -constraints posixaio -body { + open testdata.in {CREAT TRUNC} +} -returnCodes error -result {testdata.in: Invalid argument} + +test aio-9.3 {open: posix modes, bad modes} -constraints posixaio -body { + open testdata.in {WRONG TRUNC} +} -returnCodes error -result {bad access mode "WRONG": must be APPEND, BINARY, CREAT, EXCL, NOCTTY, RDONLY, RDWR, TRUNC, or WRONLY} + +test aio-9.4 {open: posix modes} -constraints posixaio -cleanup { + file delete testdata.out +} -body { + set out [open testdata.out {WRONLY CREAT TRUNC}] + $out puts write-data + $out close + # Now open for readwrite without truncate + set io [open testdata.out {RDWR CREAT}] + set buf [$io gets] + $io close + set buf +} -result {write-data} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/alias.test jimtcl-0.81+dfsg0/tests/alias.test --- jimtcl-0.79+dfsg0/tests/alias.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/alias.test 2021-11-27 23:06:54.000000000 +0000 @@ -64,6 +64,7 @@ test curry-1.5 "Delete curry" references { collect + $one abc unset one two collect } {2} @@ -145,12 +146,12 @@ } } 1 -test statics-1.2 "static variable with invalid name" { - catch { - proc a {b} "{c\0d 4}" { - } +test statics-1.2 "static variable with name containing null" { + proc a {b} "{c\0d 4}" { + return [set c\0d] } -} 1 + a 5 +} 4 test statics-1.3 "duplicate static variable" { catch { @@ -240,9 +241,28 @@ list [catch {upcall a} msg] $msg } {1 {no previous command: "a"}} -test upcall-1.4 "upcall errors" { +test upcall-1.5 "upcall errors" { proc a {} {upcall a} list [catch a msg] $msg } {1 {no previous command: "a"}} +test upcall-1.6 "delete local command" -setup { + # First make sure a is gone + rename a "" +} -body { + local proc a {x} {list 2 $x} + # It is OK to rename this local proc + rename a b + b 5 +} -result {2 5} -cleanup { + rename b "" +} + +test upcall-1.6 {delete local command with upcall} -body { + local proc a {x} {list 2 $x} + local proc a {x} {list 3 $x} + # Can't rename a because it would invalide upcalls from a + rename a c +} -returnCodes error -result {can't rename local command "a"} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/applyns.test jimtcl-0.81+dfsg0/tests/applyns.test --- jimtcl-0.79+dfsg0/tests/applyns.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/applyns.test 2021-11-27 23:06:54.000000000 +0000 @@ -88,8 +88,29 @@ set body {testApply} apply [list args $body testApply] } testApply +test apply-7.9 {namespace access} { + set ::testApply::x 0 + set body {testApply} + apply [list args $body ::testApply] +} testApply + +# apply ignore the current namespace and runs at global scope +# or the provided namespace (relative to global) +test apply-8.1 {namespace current within apply} { + namespace eval testApply {} + namespace eval testApply2 { + apply {a { return [namespace current]-$a } testApply} 5 + } +} {::testApply-5} + +test apply-8.2 {namespace current within apply} { + namespace eval testApply2 { + apply {a { return [namespace current]-$a }} 5 + } +} {::-5} namespace delete testApply +namespace delete testApply2 testreport diff -Nru jimtcl-0.79+dfsg0/tests/apply.test jimtcl-0.81+dfsg0/tests/apply.test --- jimtcl-0.79+dfsg0/tests/apply.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/apply.test 2021-11-27 23:06:54.000000000 +0000 @@ -127,6 +127,24 @@ apply [list {x {y 2} args} $applyBody] 1 3 } {{args {}} {x 1} {y 3}} +test apply-9.1 {tailcall within apply} { + proc p {y frame} { + list [expr {$y * 2}] [expr {$frame - [info frame]}] + } + apply {{x} { + tailcall p $x [info frame] + notreached + }} {4} +} {8 0} +test apply-9.2 {return from apply} { + apply {{x} { + return [expr {$x + 1}] + }} {4} +} {5} + + +rename p {} + ::tcltest::cleanupTests return diff -Nru jimtcl-0.79+dfsg0/tests/array.test jimtcl-0.81+dfsg0/tests/array.test --- jimtcl-0.79+dfsg0/tests/array.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/array.test 2021-11-27 23:06:54.000000000 +0000 @@ -111,7 +111,7 @@ test array-1.20 "array stat" -body { set output [array stat a] - regexp "1 entries in table.*number of buckets with 1 entries: 1" $output + regexp "entries in table.*buckets" $output } -result {1} test array-1.21 "array stat non-array" -body { @@ -131,4 +131,24 @@ array exists x } -result {0} +test array-2.1 {array -help} -constraints jim -body { + array -help +} -match glob -result {Usage: "array command ... ", where command is one of: *} + +test array-2.2 {array -help get} -constraints jim -body { + array -help get +} -result {Usage: array get arrayName ?pattern?} + +test array-2.3 {array -help ambiguous} -constraints jim -body { + array -help s +} -match glob -result {Usage: "array command ... ", where command is one of: *} + +test array-2.3 {array -help nomatch} -constraints jim -body { + array -help unknown +} -match glob -result {Usage: "array command ... ", where command is one of: *} + +test array-2.4 {array ambiguous} -constraints jim -body { + array s +} -returnCodes error -match glob -result {array, ambiguous command "s": should be *} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/binary.test jimtcl-0.81+dfsg0/tests/binary.test --- jimtcl-0.79+dfsg0/tests/binary.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/binary.test 2021-11-27 23:06:54.000000000 +0000 @@ -251,7 +251,7 @@ test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format c $a -} -result "expected integer but got \"0x50 0x51\"" +} -match glob -result "expected integer *but got \"0x50 0x51\"" test binary-8.11 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format c1 $a @@ -262,7 +262,7 @@ } -result {not enough arguments for all format specifiers} test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format s blat -} -result {expected integer but got "blat"} +} -match glob -result {expected integer *but got "blat"} test binary-9.3 {Tcl_BinaryObjCmd: format} { binary format s0 0x50 } {} @@ -290,7 +290,7 @@ test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format s $a -} -result "expected integer but got \"0x50 0x51\"" +} -match glob -result "expected integer *but got \"0x50 0x51\"" test binary-9.12 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format s1 $a @@ -301,7 +301,7 @@ } -result {not enough arguments for all format specifiers} test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format S blat -} -result {expected integer but got "blat"} +} -match glob -result {expected integer *but got "blat"} test binary-10.3 {Tcl_BinaryObjCmd: format} { binary format S0 0x50 } {} @@ -329,7 +329,7 @@ test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format S $a -} -result "expected integer but got \"0x50 0x51\"" +} -match glob -result "expected integer *but got \"0x50 0x51\"" test binary-10.12 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format S1 $a @@ -340,7 +340,7 @@ } -result {not enough arguments for all format specifiers} test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format i blat -} -result {expected integer but got "blat"} +} -match glob -result {expected integer *but got "blat"} test binary-11.3 {Tcl_BinaryObjCmd: format} { binary format i0 0x50 } {} @@ -371,7 +371,7 @@ test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format i $a -} -result "expected integer but got \"0x50 0x51\"" +} -match glob -result "expected integer *but got \"0x50 0x51\"" test binary-11.13 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format i1 $a @@ -382,7 +382,7 @@ } -result {not enough arguments for all format specifiers} test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format I blat -} -result {expected integer but got "blat"} +} -match glob -result {expected integer *but got "blat"} test binary-12.3 {Tcl_BinaryObjCmd: format} { binary format I0 0x50 } {} @@ -413,7 +413,7 @@ test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format I $a -} -result "expected integer but got \"0x50 0x51\"" +} -match glob -result "expected integer *but got \"0x50 0x51\"" test binary-12.13 {Tcl_BinaryObjCmd: format} { set a {0x50 0x51} binary format I1 $a @@ -1664,7 +1664,7 @@ } -result {not enough arguments for all format specifiers} test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format t blat -} -result {expected integer but got "blat"} +} -match glob -result {expected integer *but got "blat"} test binary-48.3 {Tcl_BinaryObjCmd: format} { binary format S0 0x50 } {} @@ -1710,7 +1710,7 @@ test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format t $a -} -result "expected integer but got \"0x50 0x51\"" +} -match glob -result "expected integer *but got \"0x50 0x51\"" test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian { set a {0x50 0x51} binary format t1 $a @@ -1726,7 +1726,7 @@ } -result {not enough arguments for all format specifiers} test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format n blat -} -result {expected integer but got "blat"} +} -match glob -result {expected integer *but got "blat"} test binary-49.3 {Tcl_BinaryObjCmd: format} { binary format n0 0x50 } {} @@ -1757,7 +1757,7 @@ test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { set a {0x50 0x51} binary format n $a -} -result "expected integer but got \"0x50 0x51\"" +} -match glob -result "expected integer *but got \"0x50 0x51\"" test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian { set a {0x50 0x51} binary format n1 $a diff -Nru jimtcl-0.79+dfsg0/tests/certificate.pem jimtcl-0.81+dfsg0/tests/certificate.pem --- jimtcl-0.79+dfsg0/tests/certificate.pem 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/certificate.pem 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,28 @@ +-----BEGIN CERTIFICATE----- +MIIEwDCCAqgCCQCFOs3gH4RsKTANBgkqhkiG9w0BAQUFADAiMQswCQYDVQQGEwJh +dTETMBEGA1UEAwwKamltLnRjbC50azAeFw0xOTA5MjQyMzQ2NDFaFw00NzAyMDgy +MzQ2NDFaMCIxCzAJBgNVBAYTAmF1MRMwEQYDVQQDDApqaW0udGNsLnRrMIICIjAN +BgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEA0T9HMb5b2WZDIAF7+7KZzwAEiXC5 +misVrY1gmlwvLlSVx1pXKx5KrFpwkBMfDs1Zsi03/D46N+kViOmSJY/h5nxpiTdb +s1Gld2b1RqFbnXcLmx7eWVXXouLDcmzoJM1Y7vh26e9j3Uy4Bsew7zfxgnWmbfOA +9Sg/rHamQFfJ+Ov9NglkAoGPwdIiDWc4+hkKD6HL3B72m3VyD4crDSuTm2vFqUDh +Xk+Jw3clNQYXHQrOSpDKst1qPQtEDTQbrmKhSN6jMBRwcwfo39lCZLN02jEfOC2b +wHPe+VgcyfCzWgfKHtPlhqqanSIndDSAc6aF5hzI1vlT2dZNmSWDZ6QBrwharh25 +QXcnQhDr/9DyHIjgvojROsOiSaT4pVvJRBsVm7N/7kVQKvNdbwB8itz+ubLlb5SY +ahlZNBMpE9RqgchwAwe0SpjILMBHI90/H89SrZPZ4rMitZiIq5/3mBFEy/7Xio/G +5jw/Gp3cHa6SMf/6cqhll7binB8s8Yd5c8RvdNunczCobKmbnTMDRdsnjnvWFmia +PJZUdcOtftxUCxYP2tEjapQL8kjC+K4MjCGkde/5lrd8+yRY6GK6zixxfYb1jka/ +NFdXBaws4gm8amrsFstkY3K2GqrVh44/sG7BNqsl4hxkqyHryay7B413+KUrkiET +4PqwSHgtJHPayAMCAwEAATANBgkqhkiG9w0BAQUFAAOCAgEAlieZi6YNBCKkCLVP +bIEtB/Ky28YTZ8Blv9dyOG557nfIze0NgsFJLOvLCFqKh8TKJRxGWkBeDh72ozjd +R0twQ9w/uWv/RIvBvX+O67ByN8/u3E+H8TqsnRq6FxnHLKh4MbUuNya6/dskVAtB +5JthL5EPU0z+6MqIissmx4V7d/MA3bEWF+etAnI9maxdJ2KXlqiBy0K09RCydZzi +JHSVqpY/UrwYjWxgJgMFq5ZLrMwLv2SVqFa5FnMsP2Qc1Ojgq0Jz8vbYFd9CCyyc +mZUb1fAoxKRjBOBbbgW3fYsS4MkJ1PGeUh+60beDsKZhuTe5g5KCiB0QdB53Juth +UizaqM+u2PECDV5TmhVIDCyHhGbbfzIFppsrpCZfXwtie4qqj50l55I7KoX6Twhu +7uadSWRiU60aOD7m99SUkqqkODXy2BvQixKZ6QOruTMqgbbpxpVMOUxFPkkmB5Jk +LQ+3uIjBbVKQxGzniVwYwIRCTgg1x/nTlHEr5DhEs/8MiFrw3UafX9B6m9Jo1oJh +HAs01bC9yMqNhaTXZRrGR4hEM3cmS0Sa6VYiZ+dhDwucvBwz0ClSiTT3iFjGcTMZ +r9m5x0V15qZSvj1GWp6hSWIG/NwS+4gvv75Jlx83cr+bTlHgDl8h4seEmj8HhPq1 +j9ZXBr9P2ETiD8OVyZAT3hhSwOg= +-----END CERTIFICATE----- diff -Nru jimtcl-0.79+dfsg0/tests/clock.test jimtcl-0.81+dfsg0/tests/clock.test --- jimtcl-0.79+dfsg0/tests/clock.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/clock.test 2021-11-27 23:06:54.000000000 +0000 @@ -30,6 +30,10 @@ clock format foo } -returnCodes error -result {expected integer but got "foo"} +test clock-3.7 {clock format tests} -body { + clock format 10000 -format [string repeat x 1000] -gmt true +} -returnCodes error -result {format string too long or invalid time} + test clock-3.8 {clock format tests} -body { clock format a b c d e g } -returnCodes error -result {wrong # args: should be "clock format seconds ?-format string? ?-gmt boolean?"} @@ -47,8 +51,46 @@ clock format 123 -format "x" } x +test clock-3.12 {clock format tests} -body { + clock format 123 -gmt blah +} -returnCodes error -result {expected boolean but got "blah"} + +test clock-3.13 {clock format tests} -body { + clock format 123 odd option count +} -returnCodes error -result {wrong # args: should be "clock format seconds ?-format string? ?-gmt boolean?"} + test clock-4.1 {clock scan tests} clockscan { clock scan {Sun Nov 04 03:02:46 AM 1990} -format {%a %b %d %I:%M:%S %p %Y} -gmt true } 657687766 +test clock-4.2 {clock scan tests} -constraints clockscan -body { + clock scan odd number arg count +} -returnCodes error -result {wrong # args: should be "clock scan str -format format ?-gmt boolean?"} + +test clock-4.3 {clock scan tests} -constraints clockscan -body { + clock scan str -bad option +} -returnCodes error -result {bad option "-bad": must be -format, or -gmt} + +test clock-4.4 {clock scan tests} -constraints clockscan -body { + clock scan str -gmt true +} -returnCodes error -result {wrong # args: should be "clock scan str -format format ?-gmt boolean?"} + +test clock-4.5 {clock scan tests} -constraints clockscan -body { + clock scan str -format "%H" -gmt true +} -returnCodes error -result {Failed to parse time according to format} + +test clock-5.1 {clock seconds} { + clock format [clock seconds] + list 1 +} {1} + +test clock-5.2 {clock millis, micros} { + set ms [clock millis] + set us [clock micros] + set delta [expr {abs($us - $ms * 1000)}] + if {$delta > 250000} { + error "clock millis and micros differ by too much" + } +} {} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/coverage.test jimtcl-0.81+dfsg0/tests/coverage.test --- jimtcl-0.79+dfsg0/tests/coverage.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/coverage.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,250 @@ +# various tests to improve code coverage + +source [file dirname [info script]]/testing.tcl + +testCmdConstraints getref rand namespace + +testConstraint debug-invstr 0 +catch { + debug -commands + testConstraint debug-invstr 1 +} + +test dupobj-1 {duplicate script object} { + set y {expr 2} + # make y a script + eval $y + # Now treat it as a list that needs duplicating + lset y 0 abc + set y +} {abc 2} + +test dupobj-2 {duplicate expr object} { + set y {2 + 1} + # make y an expression + expr $y + # Now treat it as a list that needs duplicating + lset y 0 abc + set y +} {abc + 1} + +test dupobj-3 {duplicate interpolated object} namespace { + set w 4 + set y def($w) + # Now treat it as a namespace object that needs duplicating + namespace eval $y {} + apply [list x {set x 1} $y] x +} {1} + +test dupobj-4 {duplicate dict subst object} namespace { + # make y a dict subst + set def(4) 5 + set y def(4) + incr $y + # Now treat it as a namespace object that needs duplicating + namespace eval $y {} + apply [list x {set x 1} $y] x +} {1} + +test dupobj-5 {duplicate object with no string rep} namespace { + # A sorted list has no string rep + set y [lsort {abc def}] + # Now treat it as a namespace object that needs duplicating + namespace eval $y {} + apply [list x {set x 1} $y] x +} {1} + +test dupobj-6 {duplicate object with no type dup proc} namespace { + set x 6 + incr x + # x is now an int, an object with no dup proc + # using as a namespace requires the object to be duplicated + namespace eval $x { + proc a {} {} + rename a "" + } +} {} + +test dupobj-7 {duplicate scan obj} namespace { + set x "%d %d" + scan "1 4" $x y z + # Now treat it as a namespace object that needs duplicating + namespace eval $x {} + apply [list x {set x 1} $x] x +} {1} + + +test script-1 {convert empty object to script} { + set empty [foreach a {} {}] + eval $empty +} {} + +test ref-1 {treat something as a reference} getref { + set ref [ref abc tag] + append ref " " + getref " $ref " +} {abc} + +test ref-2 {getref invalid reference} -constraints getref -body { + getref ".99999999999999000000>" +} -returnCodes error -match glob -result {invalid reference id *} + +test ref-3 {getref invalid reference tag} -constraints getref -body { + getref ".99999999999999000000>" +} -returnCodes error -match glob -result {expected reference but got ".99999999999999000000>"} + +test ref-4 {finalize} getref { + finalize $ref +} {} + +test ref-5 {finalize} getref { + finalize $ref cleanup + finalize $ref cleanup2 + finalize $ref +} {cleanup2} + +test ref-6 {finalize get invalid reference} -constraints getref -body { + finalize ".99999999999999000000>" +} -returnCodes error -match glob -result {invalid reference id *} + +test ref-7 {finalize set invalid reference} -constraints getref -body { + finalize ".99999999999999000000>" cleanup +} -returnCodes error -match glob -result {invalid reference id *} + +test collect-1 {recursive collect} getref { + set ref2 [ref dummy cleanup2] + unset ref2 + proc cleanup2 {ref value} { + # Try to call collect + stdout puts "in cleanup2: ref=$ref, value=$value" + if {[collect]} { + error "Should return 0" + } + } + collect +} {1} + +test scan-1 {update string of scan obj} debug-invstr { + set x "%d %d" + scan "1 4" $x y z + debug invstr $x + # x is now of scanfmt type with no string rep + set x +} {%d %d} + +# It is too hard to do this one without debug invstr +test index-1 {update string of index} debug-invstr { + set x end-1 + lindex {a b c} $x + debug invstr $x + # x is now of index type with no string rep + set x +} {end-1} + +test index-2 {update string of index} debug-invstr { + set x end + lindex {a b c} $x + debug invstr $x + # x is now of index type with no string rep + set x +} {end} + +test index-3 {update string of index} debug-invstr { + set x 2 + lindex {a b c} $x + debug invstr $x + # x is now of index type with no string rep + set x +} {2} + +test index-4 {index > INT_MAX} debug-invstr { + set x 99999999999 + incr x + # x is now of int type > INT_MAX + lindex {a b c} $x +} {} + +test index-5 {update string of index} debug-invstr { + set x -1 + lindex {a b c} $x + debug invstr $x + # x is now of index type with no string rep + set x +} {-2147483647} + +test cmd-1 {standard -commands} jim { + expr {"length" in [string -commands]} +} {1} + +test rand-1 {rand} -constraints rand -body { + rand 1 2 3 +} -returnCodes error -result {wrong # args: should be "rand ?min? max"} + +test rand-2 {rand} -constraints rand -body { + rand foo +} -returnCodes error -match glob -result {expected integer *but got "foo"} + +test rand-3 {rand} -constraints rand -body { + rand 2 bar +} -returnCodes error -match glob -result {expected integer *but got "bar"} + +test rand-4 {rand} rand { + string is integer [rand] +} {1} + +test rand-5 {srand} rand { + set x [expr {srand(123)}] + if {$x >= 0 && $x <= 1} { + return 1 + } else { + return 0 + } +} {1} + +test lreverse-1 {lreverse} -body { + lreverse +} -returnCodes error -result {wrong # args: should be "lreverse list"} + +test divide-1 {expr} -constraints jim -body { + / 2 0 +} -returnCodes error -result {Division by zero} + +test variable-1 {upvar, name with embedded null} -constraints jim -body { + proc a {} { + upvar var\0null abc + incr abc + } + set var\0null 2 + a +} -returnCodes ok -result {3} + +test variable-2 {upvar to global name} { + set ::globalvar 1 + proc a {} { + upvar ::globalvar abc + incr abc + } + a +} {2} + +test unknown-1 {recursive unknown} -body { + # unknown will call itself a maximum of 50 times before simply returning an error + proc unknown {args} { + nonexistent 3 + } + nonexistent 4 +} -returnCodes error -result {invalid command name "nonexistent"} -cleanup { + rename unknown {} +} + +test interpolate-1 {interpolate} -body { + unset -nocomplain a + for {set i 0} {$i < 10} {incr i} { + set a($i) $i + } + set x "$a(0)$a(1)$a(2)$a(3)$a(4)$a(5)$a(6)$a(7)$a(8)$a(9)$nonexistent" + set x +} -returnCodes error -result {can't read "nonexistent": no such variable} + + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/debug.test jimtcl-0.81+dfsg0/tests/debug.test --- jimtcl-0.79+dfsg0/tests/debug.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/debug.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,109 @@ +source [file dirname [info script]]/testing.tcl +needs cmd debug + +set x 0 + +test debug-0.1 {debug too few args} -body { + debug +} -returnCodes error -result {wrong # args: should be "debug subcommand ?...?"} + +test debug-0.2 {debug bad option} -body { + debug badoption +} -returnCodes error -result {bad subcommand "badoption": must be exprbc, exprlen, invstr, objcount, objects, refcount, scriptlen, or show} + +test debug-1.1 {debug refcount too few args} -body { + debug refcount +} -returnCodes error -result {wrong # args: should be "debug refcount object"} + +test debug-1.2 {debug refcount test} -body { + debug refcount x +} -result {2} + +test debug-1.3 {debug refcount too many args} -body { + debug refcount a b c +} -returnCodes error -result {wrong # args: should be "debug refcount object"} + +test debug-2.1 {debug objcount} -body { + regexp {free \d+ used \d+} [debug objcount] +} -result {1} + +test debug-2.2 {debug objcount too many args} -body { + debug objcount a b c +} -returnCodes error -result {wrong # args: should be "debug objcount"} + +test debug-3.1 {debug objects} -body { + expr {[llength [debug objects]] > 1000} +} -result {1} + +# does not currently check for too many args +test debug-3.2 {debug objects too many args} -body { + debug objects a b c +} -returnCodes error -result {wrong # args: should be "debug objects"} + +test debug-4.1 {debug invstr too few args} -body { + debug invstr +} -returnCodes error -result {wrong # args: should be "debug invstr object"} + +test debug-4.2 {debug invstr} -body { + debug invstr x +} -result {} + +test debug-4.3 {debug invstr too many args} -body { + debug invstr a b c +} -returnCodes error -result {wrong # args: should be "debug invstr object"} + +test debug-5.1 {debug scriptlen too few args} -body { + debug scriptlen +} -returnCodes error -result {wrong # args: should be "debug scriptlen script"} + +test debug-5.2 {debug scriptlen} -body { + debug scriptlen {puts "hello world"} +} -result {3} + +test debug-5.3 {debug scriptlen too many args} -body { + debug scriptlen a b c +} -returnCodes error -result {wrong # args: should be "debug scriptlen script"} + +test debug-6.1 {debug exprlen too few args} -body { + debug exprlen +} -returnCodes error -result {wrong # args: should be "debug exprlen expression"} + +test debug-6.2 {debug exprlen} -body { + debug exprlen { $x + 10 } +} -result {3} + +test debug-6.3 {debug exprlen too many args} -body { + debug exprlen a b c +} -returnCodes error -result {wrong # args: should be "debug exprlen expression"} + +test debug-7.1 {debug exprbc too few args} -body { + debug exprbc +} -returnCodes error -result {wrong # args: should be "debug exprbc expression"} + +test debug-7.2 {debug exprbc} -body { + set y [dict create] + dict set y z 1 + debug exprbc { $x + 10 + 1.5 + true + [llength {{1} {2}}] + "5" + $y(z) + "\x33"} +} -result {+ {+ {+ {+ {+ {+ {+ {VAR x} {INT 10}} {DBL 1.5}} {BOO true}} {CMD {llength {{1} {2}}}}} {STR 5}} {ARY y(z)}} {ESC {\x33}}} + +test debug-7.4 {debug exprbc too many args} -body { + debug exprbc a b c +} -returnCodes error -result {wrong # args: should be "debug exprbc expression"} + +test debug-8.1 {debug show too few args} -body { + debug show +} -returnCodes error -result {wrong # args: should be "debug show object"} + +test debug-8.1 {debug show} -body { + set x hello + lappend x there + debug show $x +} -result {refcount: 2, type: list +chars (11): <> +bytes (11): 68 65 6c 6c 6f 20 74 68 65 72 65} + +test debug-8.3 {debug show too many args} -body { + debug show a b c +} -returnCodes error -result {wrong # args: should be "debug show object"} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/dict2.test jimtcl-0.81+dfsg0/tests/dict2.test --- jimtcl-0.79+dfsg0/tests/dict2.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/dict2.test 2021-11-27 23:06:54.000000000 +0000 @@ -95,7 +95,7 @@ test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b test dict-3.12 {dict get command} -returnCodes error -body { dict get -} -result {wrong # args: should be "dict get dictionary ?key ...?"} +} -match glob -result {wrong # args: should be "dict get dictionary ?key*?"} test dict-3.13 {dict get command} -body { set dict [dict get {a b c d}] if {$dict eq "a b c d"} { @@ -316,14 +316,14 @@ dict-sort $dictv } -cleanup { unset dictv -} -result {expected integer but got "dummy"} +} -match glob -result {expected integer *but got "dummy"} test dict-11.10 {dict incr command} -returnCodes error -body { set dictv {a 1} dict incr dictv a dummy dict-sort $dictv } -cleanup { unset dictv -} -result {expected integer but got "dummy"} +} -match glob -result {expected integer *but got "dummy"} test dict-11.11 {dict incr command} -setup { unset -nocomplain dictv } -body { @@ -1250,5 +1250,34 @@ } -cleanup { unset foo t inner } -result OK + +set dictnulls {ab\0c de\0f \0ghi kl\0m} +set dictgood [array get tcl_platform] +set dictbad {abc def ghi} + +test dict-23.1 {dict info} { + regexp {entries in table,.*buckets} [dict info $dictgood] +} {1} + +test dict-23.2 {dict info usage} -body { + dict info +} -returnCodes error -result {wrong # args: should be "dict info dictionary"} + +test dict-23.3 {dict info baddict} -body { + dict info $dictbad +} -returnCodes error -result {missing value to go with key} + +test dict-23.4 {dict with usage} -body { + dict with +} -returnCodes error -result {wrong # args: should be "dict with dictVar ?key ...? script"} + +test dict-23.5 {dict with badvar} -constraints jim -body { + dict with dictnulls {lsort [info locals]} +} -returnCodes ok -result [list ab\0c de\0f \0ghi kl\0m] + +test dict-23.6 {dict with baddict} -body { + dict with dictbad {} +} -returnCodes error -result {missing value to go with key} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/dict.test jimtcl-0.81+dfsg0/tests/dict.test --- jimtcl-0.79+dfsg0/tests/dict.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/dict.test 2021-11-27 23:06:54.000000000 +0000 @@ -249,4 +249,147 @@ llength $a } 12 +# As of 0.79, dicts maintain insertion order +test dict-25.1 {dict ordering} { + dict keys {a x 0 y} +} {a 0} + +test dict-25.2 {dict ordering} { + dict keys {0 x a y} +} {0 a} + +test dict-25.3 {dict ordering} { + set d [dict create a y 0 x 2 z] + dict set d 1 w + dict keys $d +} {a 0 2 1} + +test dict-25.3 {dict ordering} { + set d [dict create a y 0 x 2 z] + dict set d 0 w + dict keys $d +} {a 0 2} + +test dict-25.4 {removal of keys that hash earlier} { + set parsed {formPost {text {This is text.} {text file} Hello. {image file} abc}} + + dict unset parsed formPost text + dict unset parsed formPost {image file} + dict get $parsed formPost {text file} +} Hello. + +test dict-25.5 {list to dict, duplicate keys} { + set l [list a 1 a 2 a 3] + # make sure there is no string rep + lappend l b 4 + dict get $l a +} {3} + +# Follow Tcl, to force interpretation, not compilation. +# No effect in Jim +set dict dict +test dict-26.1 {dict getdef command} -body { + dict getdef {a b} a c +} -result b +test dict-26.2 {dict getdef command} -body { + dict getdef {a b} b c +} -result c +test dict-26.3 {dict getdef command} -body { + dict getdef {a {b c}} a b d +} -result c +test dict-26.4 {dict getdef command} -body { + dict getdef {a {b c}} a c d +} -result d +test dict-26.5 {dict getdef command} -body { + dict getdef {a {b c}} b c d +} -result d +test dict-26.6 {dict getdef command} -returnCodes error -body { + dict getdef {a {b c d}} a b d +} -result {missing value to go with key} +test dict-26.7 {dict getdef command} -returnCodes error -body { + dict getdef +} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"} +test dict-26.8 {dict getdef command} -returnCodes error -body { + dict getdef {} +} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"} +test dict-26.9 {dict getdef command} -returnCodes error -body { + dict getdef {} {} +} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"} +test dict-26.10 {dict getdef command} -returnCodes error -body { + dict getdef {a b c} d e +} -result {missing value to go with key} +test dict-26.11 {dict getdef command} -body { + $dict getdef {a b} a c +} -result b +test dict-26.12 {dict getdef command} -body { + $dict getdef {a b} b c +} -result c +test dict-26.13 {dict getdef command} -body { + $dict getdef {a {b c}} a b d +} -result c +test dict-26.14 {dict getdef command} -body { + $dict getdef {a {b c}} a c d +} -result d +test dict-26.15 {dict getdef command} -body { + $dict getdef {a {b c}} b c d +} -result d +test dict-26.16 {dict getdef command} -returnCodes error -body { + $dict getdef {a {b c d}} a b d +} -result {missing value to go with key} +test dict-26.17 {dict getdef command} -returnCodes error -body { + $dict getdef {a b c} d e +} -result {missing value to go with key} + +test dict-27.1 {dict getwithdefault command} -body { + dict getwithdefault {a b} a c +} -result b +test dict-27.2 {dict getwithdefault command} -body { + dict getwithdefault {a b} b c +} -result c +test dict-27.3 {dict getwithdefault command} -body { + dict getwithdefault {a {b c}} a b d +} -result c +test dict-27.4 {dict getwithdefault command} -body { + dict getwithdefault {a {b c}} a c d +} -result d +test dict-27.5 {dict getwithdefault command} -body { + dict getwithdefault {a {b c}} b c d +} -result d +test dict-27.6 {dict getwithdefault command} -returnCodes error -body { + dict getwithdefault {a {b c d}} a b d +} -result {missing value to go with key} +test dict-27.7 {dict getwithdefault command} -returnCodes error -body { + dict getwithdefault +} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"} +test dict-27.8 {dict getwithdefault command} -returnCodes error -body { + dict getwithdefault {} +} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"} +test dict-27.9 {dict getwithdefault command} -returnCodes error -body { + dict getwithdefault {} {} +} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"} +test dict-27.10 {dict getdef command} -returnCodes error -body { + dict getwithdefault {a b c} d e +} -result {missing value to go with key} +test dict-27.11 {dict getwithdefault command} -body { + $dict getwithdefault {a b} a c +} -result b +test dict-27.12 {dict getwithdefault command} -body { + $dict getwithdefault {a b} b c +} -result c +test dict-27.13 {dict getwithdefault command} -body { + $dict getwithdefault {a {b c}} a b d +} -result c +test dict-27.14 {dict getwithdefault command} -body { + $dict getwithdefault {a {b c}} a c d +} -result d +test dict-27.15 {dict getwithdefault command} -body { + $dict getwithdefault {a {b c}} b c d +} -result d +test dict-27.16 {dict getwithdefault command} -returnCodes error -body { + $dict getwithdefault {a {b c d}} a b d +} -result {missing value to go with key} +test dict-27.17 {dict getdef command} -returnCodes error -body { + $dict getwithdefault {a b c} d e +} -result {missing value to go with key} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/errors.tcl jimtcl-0.81+dfsg0/tests/errors.tcl --- jimtcl-0.79+dfsg0/tests/errors.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/errors.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -21,7 +21,7 @@ package require dummy } source { - source dummy.tcl + source [file dirname [info script]]/dummy.tcl } badpackage { package require bogus diff -Nru jimtcl-0.79+dfsg0/tests/error.test jimtcl-0.81+dfsg0/tests/error.test --- jimtcl-0.79+dfsg0/tests/error.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/error.test 2021-11-27 23:06:54.000000000 +0000 @@ -15,7 +15,7 @@ set rc [catch {b} msg] #puts stderr "error-1.1\n[errorInfo $msg]\n" - list $rc $msg [info stacktrace] + list $rc $msg [basename-stacktrace [info stacktrace]] } {1 {error thrown from a} {{} error.test 4 a error.test 8 b error.test 15}} proc c {} { @@ -44,12 +44,12 @@ # Now rethrow with the new stack set rc [catch {error $msg $newst} msg] #puts [errorInfo $msg] - info stacktrace + basename-stacktrace [info stacktrace] } {{} error.test 4 a error.test 22 c error.test 26 e error.test 34} # Package should be able to invoke exit, which should exit if not caught test error-2.1 "Exit from package" { - list [catch -exit {package require exitpackage} msg] $msg -} {6 {Can't load package exitpackage}} + catch -exit {package require exitpackage} msg +} 6 testreport diff -Nru jimtcl-0.79+dfsg0/tests/event.test jimtcl-0.81+dfsg0/tests/event.test --- jimtcl-0.79+dfsg0/tests/event.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/event.test 2021-11-27 23:06:54.000000000 +0000 @@ -81,6 +81,19 @@ set errRes; } err1 +# Tcl handles errors in bgerror slightly differently +# Jim prints the original error to stderr +test event-7.4 {bgerror throws an error} -constraints jim -body { + exec [info nameofexecutable] - << { + proc bgerror {err} { + error "inside bgerror" + } + after 0 {error err1} + update + } +} -result {stdin:3: Error: inside bgerror +at file "stdin", line 3} + # end of bgerror tests catch {rename bgerror {}} @@ -185,14 +198,14 @@ foreach i [after info] { after cancel $i } - after 10; update; # On Mac make sure update won't take long - after 200 {set x x-done} - after 400 {set y y-done} + after 20; update; # On Mac make sure update won't take long + after 400 {set x x-done} + after 800 {set y y-done} after idle {set z z-done} set x before set y before set z before - after 300 + after 600 update list $x $y $z } {x-done before z-done} @@ -212,6 +225,21 @@ } msg] $msg } {5 SIGALRM} +test event-13.2 {after info invalid} -body { + after info not-a-valid-id +} -returnCodes error -result {event "not-a-valid-id" doesn't exist} + +test event-13.3 {after info noexist} -body { + after info after#99999999 +} -returnCodes error -result {event "after#99999999" doesn't exist} + +test event-13.4 {after info usage} -body { + after info too-many args +} -returnCodes error -result {wrong # args: should be "after info ?id?"} + +test event-13.5 {after cancel noexist} { + after cancel after#99999999 +} {} test event-14.1 {socket stream.server client address} {jim socket} { set s1 [socket stream.server 5001] diff -Nru jimtcl-0.79+dfsg0/tests/exec2.test jimtcl-0.81+dfsg0/tests/exec2.test --- jimtcl-0.79+dfsg0/tests/exec2.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/exec2.test 2021-11-27 23:06:54.000000000 +0000 @@ -5,9 +5,15 @@ source [file dirname [info script]]/testing.tcl needs cmd exec -foreach i {pipe signal wait} { - testConstraint $i [expr {[info commands $i] ne ""}] +testCmdConstraints signal wait alarm after + +# Jim needs [pipe] to implement [open |command] +if {[testConstraint tcl]} { + testConstraint pipe 1 +} else { + testCmdConstraints pipe } + # Some Windows platforms (e.g. AppVeyor) produce ENOSPC rather than killing # the child with SIGPIPE). So turn off this test for that platform if {[info exists env(MSYSTEM)] && $env(MSYSTEM) eq "MINGW32"} { @@ -54,14 +60,14 @@ array set env [array get saveenv] -test exec2-3.1 "close pipeline return value" { +test exec2-3.1 "close pipeline return value" pipe { set f [open |false] set rc [catch {close $f} msg opts] lassign [dict get $opts -errorcode] status pid exitcode list $rc $msg $status $exitcode } {1 {child process exited abnormally} CHILDSTATUS 1} -test exec2-3.2 "close pipeline return value" -constraints {pipe nomingw32} -body { +test exec2-3.2 "close pipeline return value" -constraints {jim pipe nomingw32} -body { # Create a pipe and immediately close the read end lassign [pipe] r w close $r @@ -100,4 +106,69 @@ } } -result {CHILDSTATUS 0} +test exec2-4.1 {redirect from invalid filehandle} -body { + exec cat <@bogus +} -returnCodes error -match glob -result {*"bogus"} + +test exec2-4.2 {env is invalid dict} -constraints jim -body { + set saveenv $env + lappend env bogus + catch {exec pwd} +} -result {0} -cleanup { + set env $saveenv +} + +test exec2-4.3 {signalled process during foreground exec} -constraints {jim alarm} -body { + # We need to exec a pipeline and then have one process + # be killed by a signal + exec [info nameofexecutable] -e {alarm 0.1; sleep 0.5} +} -returnCodes error -result {child killed by signal SIGALRM} + +test exec2-4.4 {exec - consecutive |} -body { + exec echo | | test +} -returnCodes error -result {illegal use of | or |& in command} + +test exec2-4.5 {exec - consecutive | with &} -body { + exec echo | | test & +} -returnCodes error -result {illegal use of | or |& in command} + +test exec2-4.6 {exec - illegal channel} -body { + exec echo hello >@nonexistent +} -returnCodes error -match glob -result {*"nonexistent"} + +test exec2-5.1 {wait with invalid pid} wait { + wait 9999999 +} {NONE -1 -1} + +test exec2-5.2 {wait with invalid pid} -constraints wait -body { + wait blah +} -returnCodes error -result {expected integer but got "blah"} + +test exec2-5.3 {wait - bad args} -constraints wait -body { + wait too many args +} -returnCodes error -result {wrong # args: should be "wait ?-nohang? ?pid?"} + +test exec2-5.4 {wait -nohang} -constraints wait -body { + set pid [exec sleep 0.2 &] + # first wait will do nothing as the process is not finished + wait -nohang $pid + wait $pid +} -match glob -result {CHILDSTATUS * 0} + +test exec2-5.5 {wait for all children} -constraints {after jim} -body { + # We want to have children finish at different times + # so that we test the handling of the wait table + foreach i {0.1 0.2 0.6 0.5 0.4 0.3} { + exec sleep $i & + } + # reap zombies, there should not be any + wait + after 300 + # reap zombies, 2-3 should be finished now + wait + after 400 + # reap zombies, all processes should be finished now + wait +} -result {} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/exec.test jimtcl-0.81+dfsg0/tests/exec.test --- jimtcl-0.79+dfsg0/tests/exec.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/exec.test 2021-11-27 23:06:54.000000000 +0000 @@ -18,6 +18,13 @@ needs cmd exec needs cmd flush +# Jim needs [pipe] to implement [open |command] +if {[testConstraint tcl]} { + testConstraint pipe 1 +} else { + testCmdConstraints pipe +} + testConstraint unix [expr {$tcl_platform(platform) eq {unix}}] # Sleep which supports fractions of a second @@ -415,7 +422,7 @@ test exec-17.1 {redirecting from command pipeline} -setup { makeFile "abc\nghi\njkl" gorp.file -} -body { +} -constraints pipe -body { set f [open "|cat gorp.file | wc -l" r] set result [lindex [exec cat <@$f] 0] close $f @@ -426,7 +433,7 @@ test exec-17.2 {redirecting to command pipeline} -setup { makeFile "abc\nghi\njkl" gorp.file -} -body { +} -constraints pipe -body { set f [open "|wc -l >gorp2.file" w] exec cat gorp.file >@$f flush $f diff -Nru jimtcl-0.79+dfsg0/tests/exists.test jimtcl-0.81+dfsg0/tests/exists.test --- jimtcl-0.79+dfsg0/tests/exists.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/exists.test 2021-11-27 23:06:54.000000000 +0000 @@ -1,79 +1,87 @@ source [file dirname [info script]]/testing.tcl needs cmd exists -testConstraint lambda [expr {[info commands lambda] ne {}}] +testCmdConstraints lambda test exists-1.1 "Exists var" { set a 1 exists a } 1 -test exists-1.1 "Exists var" { +test exists-1.2 "Exists var" { unset -nocomplain b exists b } 0 -test exists-1.1 "Exists -var" { +test exists-1.3 "Exists -var" { exists -var a } 1 -test exists-1.1 "Exists -var" { +test exists-1.4 "Exists -var" { exists -var b } 0 -test exists-1.1 "Exists in proc" { +test exists-1.5 "Exists in proc" { proc a {name} { exists $name } a ::a } 1 -test exists-1.1 "Exists in proc" { +test exists-1.6 "Exists in proc" { a ::b } 0 -test exists-1.1 "Exists in proc" { +test exists-1.7 "Exists in proc" { a name } 1 -test exists-1.1 "Exists in proc" { +test exists-1.8 "Exists in proc" { a none } 0 -test exists-1.1 "Exists -proc" { +test exists-1.9 "Exists -proc" { exists -proc a } 1 -test exists-1.1 "Exists -proc" { +test exists-1.10 "Exists -proc" { exists -proc bogus } 0 -test exists-1.1 "Exists -proc" { +test exists-1.11 "Exists -proc" { exists -proc info } 0 -test exists-1.1 "Exists -command" { +test exists-1.12 "Exists -command" { exists -command a } 1 -test exists-1.1 "Exists -command" { +test exists-1.13 "Exists -command" { exists -command info } 1 -test exists-1.1 "Exists -command" { +test exists-1.14 "Exists -command" { exists -command bogus } 0 -test exists-1.1 "Exists local lambda after exit" lambda { +test exists-1.15 "Exists local lambda after exit" lambda { proc a {} { local lambda {} {dummy} } exists -proc [a] } 0 -test exists-1.1 "Exists local lambda" lambda { +test exists-1.16 "Exists local lambda" lambda { proc a {} { exists -proc [local lambda {} {dummy}] } a } 1 +test exists-1.17 {exists usage} -body { + exists -dummy blah +} -returnCodes error -result {bad option "-dummy": must be -alias, -command, -proc, or -var} + +test exists-1.18 {exists usage} -body { + exists abc def ghi +} -returnCodes error -result {wrong # args: should be "exists ?option? name"} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/exitpackage.tcl jimtcl-0.81+dfsg0/tests/exitpackage.tcl --- jimtcl-0.79+dfsg0/tests/exitpackage.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/exitpackage.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -1,3 +1,3 @@ # This package just exits -exit 1 +exit diff -Nru jimtcl-0.79+dfsg0/tests/expect.tcl jimtcl-0.81+dfsg0/tests/expect.tcl --- jimtcl-0.79+dfsg0/tests/expect.tcl 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/expect.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,237 @@ +# A simplified version of Tcl expect using a pseudo-tty pair +# This could be turned into a standard module, but for now +# it is just used in the test suite + +# Example usage: +# +# set p [expect::spawn {cmd pipeline}] +# +# $p timeout 5 +# $p send "a command\r" +# $p expect { +# ab.*c { +# script +# } +# d[a-z] { +# script +# } +# EOF { ... } +# TIMEOUT { ... } +# } +# +# [$p before] returns data before the match +# [$p after] returns data that matches the pattern +# [$p buf] returns any data after the match that has been read +# $p close +# +# $p tty ?...? +# $p kill ?SIGNAL? +if {![exists -command namespace]} { + # Just enough to support [namespace current] + proc namespace {args} { + return "" + } +} + +proc expect::spawn {cmd} { + lassign [socket pty] m s + # By default, turn off echo so that we can see just the output, not the input + $m tty echo 0 + $m buffering none + try { + lappend cmd <@$s >@$s & + set pids [exec {*}$cmd] + $s close + # Create a unique global variable for vwait + set donevar ::[ref "" expect] + set $donevar 0 + set matchinfo { + buf {} + } + + return [namespace current]::[lambda {cmd args} {m pids {timeout 30} donevar matchinfo {debug 0}} { + #puts "expect::spawn cmd=$cmd, matchinfo=$matchinfo" + # Find our own name + set self [lindex [info level 0] 0] + + switch -exact -- $cmd { + dputs { + if {$debug} { + set escapes {13 \\r 10 \\n 9 \\t 92 \\\\} + lassign $args str + # convert non-printable chars to printable + set formatted {} + binary scan $str cu* chars + foreach c $chars { + if {[exists escapes($c)]} { + append formatted $escapes($c) + } elseif {$c < 32} { + append formatted [format \\x%02x $c] + } elseif {$c > 127} { + append formatted [format \\u%04x $c] + } else { + append formatted [format %c $c] + } + } + puts $formatted + } + } + kill { + # kill the process with the given signal + foreach i $pids { + kill {*}$args $i + } + } + pid { + # return the process pids + return $pids + } + getfd - tty { + # pass through to the pty file descriptor + tailcall $m $cmd {*}$args + } + close { + # close the file descriptor, wait for the child process to complete + # and return the result + $m close + set retopts {} + foreach p $pids { + lassign [wait $p] status - rc + if {$status eq "CHILDSTATUS"} { + # Don't treat a non-zero return code as fatal here + if {[llength $retopts] <= 1} { + set retopts $rc + } + continue + } else { + set msg "child killed: received signal" + } + set retopts [list -code error -errorcode [list $status $p $rc] $msg] + } + rename $self "" + + return {*}$retopts + } + timeout - debug { + # set or return the variable + if {[llength $args]} { + set $cmd [lindex $args 0] + } else { + return [set $cmd] + } + } + send { + $self dputs ">>> [lindex $args 0]" + # send to the process + $m puts -nonewline [lindex $args 0] + $m flush + } + before - after - buf { + # return the before, after and remaining data + return $matchinfo($cmd) + } + handle { + # Internal use only + set args [lassign $args type] + switch -- $type { + timeout { + $self dputs "\[TIMEOUT patterns=$matchinfo(patterns) buf=$matchinfo(buf)\]" + # a timeout occurred + set matchinfo(before) $matchinfo(buf) + set matchinfo(buf) {} + set matchinfo(matched_pattern) TIMEOUT + incr $donevar + return 1 + } + eof { + $self dputs "\[EOF\]" + # EOF was reached + set matchinfo(before) $matchinfo(buf) + set matchinfo(buf) {} + set matchinfo(matched_pattern) EOF + incr $donevar + return 1 + } + data { + # data was received + lassign $args data + $self dputs "<<< $data" + append matchinfo(buf) $data + foreach pattern $matchinfo(patterns) { + set result [regexp -inline -indices $pattern $matchinfo(buf)] + if {[llength $result]} { + $self dputs "MATCH=\[$pattern\]" + lassign [lindex $result 0] start end + set matchinfo(before) [string range $matchinfo(buf) 0 $start-1] + set matchinfo(after) [string range $matchinfo(buf) $start $end] + set matchinfo(buf) [string range $matchinfo(buf) $end+1 end] + + # Got a match, stop + set matchinfo(matched_pattern) $pattern + incr $donevar + return 1 + } + } + } + } + return 0 + } + expect { + # Takes a list of regex-pattern, script, ... where the last script can be missing + if {[llength $args] % 2 == 1} { + lappend args {} + } + + # Stash all the state in the matchinfo dict + # Keep matchinfo(buf) + array set matchinfo { + before {} + after {} + patterns {} + matched_pattern {} + } + + foreach {pattern script} $args { + lappend matchinfo(patterns) $pattern + } + + # Handle the case where there is buffered data + # that matches the pattern + if {[$self handle data {}] == 0} { + $m readable [namespace current]::[lambda {} {m self} { + $m ndelay 1 + try { + set buf [$m read] + if {$buf eq ""} { + $self handle eof "EOF" + } else { + $self handle data $buf + } + } on error msg { + $self handle eof $msg + } + $m ndelay 0 + }] + set matchinfo(afterid) [after $($timeout * 1e3) [list $self handle timeout]] + + vwait $donevar + + after cancel $matchinfo(afterid) + } + + # Now invoke the matching script + if {[dict exists $args $matchinfo(matched_pattern)]} { + uplevel 1 [dict get $args $matchinfo(matched_pattern)] + } + # And return the data that matched the pattern + # (is $matchinfo(before) more generally useful?) + return $matchinfo(after) + } + } + }] + } on error {error opts} { + catch {$m close} + catch {$s close} + return -code error $error + } +} diff -Nru jimtcl-0.79+dfsg0/tests/expr-base.test jimtcl-0.81+dfsg0/tests/expr-base.test --- jimtcl-0.79+dfsg0/tests/expr-base.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/expr-base.test 2021-11-27 23:06:54.000000000 +0000 @@ -15,6 +15,11 @@ -0b111 -7 -0B101 -5 0o7 7 + 0d0 0 + 0d7 7 + 0d99 99 + 0d099 99 + -0d099 -99 } set i 0 @@ -34,6 +39,8 @@ 0x-5 {0x 5} {0o8 + 1} + 0d-5 + 0dff } set i 0 diff -Nru jimtcl-0.79+dfsg0/tests/expr-new.test jimtcl-0.81+dfsg0/tests/expr-new.test --- jimtcl-0.79+dfsg0/tests/expr-new.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/expr-new.test 2021-11-27 23:06:54.000000000 +0000 @@ -70,10 +70,10 @@ expr -25 } -25 test expr-1.3 {TclCompileExprCmd: two expression words} { - expr -8.2 -6 + expr {-8.2 -6} } -14.2 test expr-1.4 {TclCompileExprCmd: five expression words} { - expr 20 - 5 +10 -7 + expr {20 - 5 +10 -7} } 18 test expr-1.5 {TclCompileExprCmd: quoted expression word} { expr "0005" @@ -111,7 +111,7 @@ } foo test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} { set a xxx - set x 2; set b {$x}; set a [expr $b == 2] + set x 2; set b {$x}; set a [expr "$b == 2"] set a } 1 @@ -262,6 +262,28 @@ } {1} +test expr-8.36 {CompileEqualtyExpr: string comparison ops} { + set x 012 + set y 0x0 + list [expr {$x < $y}] [expr {$x lt $y}] [expr {$x lt $x}] +} {0 1 0} +test expr-8.37 {CompileEqualtyExpr: string comparison ops} { + set x 012 + set y 0x0 + list [expr {$x <= $y}] [expr {$x le $y}] [expr {$x le $x}] +} {0 1 1} +test expr-8.38 {CompileEqualtyExpr: string comparison ops} { + set x 012 + set y 0x0 + list [expr {$x > $y}] [expr {$x gt $y}] [expr {$x gt $x}] +} {1 0 0} +test expr-8.39 {CompileEqualtyExpr: string comparison ops} { + set x 012 + set y 0x0 + list [expr {$x >= $y}] [expr {$x ge $y}] [expr {$x ge $x}] +} {1 0 1} + + test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63 test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1 @@ -627,6 +649,89 @@ } } 1 +# This test won't fail if shimmering isn't handled +# correctly, but it will leak memory. configure with --maintainer +# to see the issue. +test expr-21.1 {expr shimmering} { + set x {[a] + 2} + proc a {} { + upvar x x + # make the expression become a list while we are executing it + lindex $x 2 + } + expr $x +} {4} + +test expr-22.1 {expr} -body { + expr {1 + $nonexistent} +} -returnCodes error -result {can't read "nonexistent": no such variable} + +test expr-22.2 {expr} -body { + expr {~$nonexistent} +} -returnCodes error -result {can't read "nonexistent": no such variable} + +test expr-22.3 {expr} -body { + expr {abs($nonexistent)} +} -returnCodes error -result {can't read "nonexistent": no such variable} + +test expr-22.4 {expr} -body { + expr {[nonexistent] << 4} +} -returnCodes error -result {invalid command name "nonexistent"} + +test expr-22.5 {expr} -body { + expr {5 >> [nonexistent]} +} -returnCodes error -result {invalid command name "nonexistent"} + +test expr-22.6 {expr} -body { + expr {$nonexistent in {a b c}} +} -returnCodes error -result {can't read "nonexistent": no such variable} + +test expr-22.7 {expr} -body { + expr {"a" ni $nonexistent} +} -returnCodes error -result {can't read "nonexistent": no such variable} + +test expr-22.8 {expr} -body { + expr {5 + $} +} -returnCodes error -result {syntax error in expression: "5 + $"} + +test expr-22.9 {expr} -body { + expr {. + 1} +} -returnCodes error -result {syntax error in expression: ". + 1"} + +test expr-22.10 {expr} -body { + expr {5 + ,} +} -returnCodes error -result {unexpected comma in expression: "5 + ,"} + +test expr-22.11 {expr} -body { + expr {round(1,2,3,4)} +} -returnCodes error -result {too many arguments to math function} + +test expr-22.12 {expr} { + expr {inf} +} {Inf} + +test expr-23.1 {expr TIP 582 comments} { + expr {1 + # comment on line 1 + 2} +} {3} + +test expr-23.2 {expr TIP 582 comments} { + expr {1 + + # comment on line 2 + 2 + } +} {3} + +test expr-23.3 {expr TIP 582 comments} { + expr {1 + + # Multiple lines + # of comments + 2 + } +} {3} + + + # cleanup if {[info exists a]} { unset a diff -Nru jimtcl-0.79+dfsg0/tests/expr-old.test jimtcl-0.81+dfsg0/tests/expr-old.test --- jimtcl-0.79+dfsg0/tests/expr-old.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/expr-old.test 2021-11-27 23:06:54.000000000 +0000 @@ -128,7 +128,7 @@ test expr-old-2.36 {floating-point operators} {expr 3.3>2.3?44.3:66.3} 44.3 test expr-old-2.37 {floating-point operators} {expr 2.3>3.3?44.3:66.3} 66.3 test expr-old-2.38 {floating-point operators} { - list [catch {expr 028.1 + 09.2} msg] $msg + list [catch {expr {028.1 + 09.2}} msg] $msg } {0 37.3} # Operators that aren't legal on floating-point numbers @@ -443,9 +443,11 @@ test expr-old-26.10 {error conditions} { expr 2.0/0.0 } {Inf} -test expr-old-26.11 {error conditions} { - list [catch {expr 2#} msg] -} {1} +# Note that this is no longer an error with TIP 582 +# +#test expr-old-26.11 {error conditions} { +# list [catch {expr 2#} msg] +#} {1} test expr-old-26.12 {error conditions} { list [catch {expr a.b} msg] } {1} @@ -551,7 +553,7 @@ # Expressions spanning multiple arguments test expr-old-31.1 {multiple arguments to expr command} { - expr 4 + ( 6 *12) -3 + expr {4 + ( 6 *12) -3} } 73 test expr-old-31.2 {multiple arguments to expr command} { list [catch {expr 2 + (3 + 4} msg] @@ -575,7 +577,7 @@ format %.6g [expr atan(1.0)] } {0.785398} test expr-old-32.4 {math functions in expressions} mathfunc { - format %.6g [expr atan2(2.0, 2.0)] + format %.6g [expr {atan2(2.0, 2.0)}] } {0.785398} test expr-old-32.5 {math functions in expressions} mathfunc { format %.6g [expr ceil(1.999)] @@ -596,10 +598,10 @@ format %.6g [expr floor(2.001)] } {2} test expr-old-32.11 {math functions in expressions} expr_fmod { - format %.6g [expr fmod(7.3, 3.2)] + format %.6g [expr {fmod(7.3, 3.2)}] } {0.9} test expr-old-32.12 {math functions in expressions} expr_hypot { - format %.6g [expr hypot(3.0, 4.0)] + format %.6g [expr {hypot(3.0, 4.0)}] } {5} test expr-old-32.13 {math functions in expressions} mathfunc { format %.6g [expr log(2.8)] @@ -608,7 +610,7 @@ format %.6g [expr log10(2.8)] } {0.447158} test expr-old-32.15 {math functions in expressions} mathfunc { - format %.6g [expr pow(2.1, 3.1)] + format %.6g [expr {pow(2.1, 3.1)}] } {9.97424} test expr-old-32.16 {math functions in expressions} mathfunc { format %.6g [expr sin(.1)] @@ -690,7 +692,7 @@ # list [catch {expr round(-1e60)} msg] $msg #} {1 {integer value too large to represent}} test expr-old-32.41 {math functions in expressions} mathfunc { - list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg + list [catch {expr {pow(1.0 + 3.0 - 2, .8 * 5)}} msg] $msg } {0 16.0} if {1} { test expr-old-32.42 {math functions in expressions} expr_hypot { @@ -700,7 +702,7 @@ expr {pow(1.0 + 3.0, -2)} } {0.0625} test expr-old-32.45 {math functions in expressions} { - expr (0 <= rand()) && (rand() < 1) + expr {(0 <= rand()) && (rand() < 1)} } {1} test expr-old-32.46 {math functions in expressions} -body { expr rand(24) @@ -717,7 +719,7 @@ } -returnCodes error -match glob -result * test expr-old-32.50 {math functions in expressions} mathfunc { for {set i 0} {$i < 10} {incr i} { - lappend result [expr round(sin($i) * 1000)] + lappend result [expr {round(sin($i) * 1000)}] } set result } {0 841 909 141 -757 -959 -279 657 989 412} @@ -726,13 +728,13 @@ } -returnCodes error -match glob -result * test expr-old-33.1 {conversions and fancy args to math functions} expr_hypot { - expr hypot ( 3 , 4 ) + expr {hypot ( 3 , 4 )} } 5.0 test expr-old-33.2 {conversions and fancy args to math functions} expr_hypot { - expr hypot ( (2.0+1.0) , 4 ) + expr {hypot ( (2.0+1.0) , 4 )} } 5.0 test expr-old-33.3 {conversions and fancy args to math functions} expr_hypot { - expr hypot ( 3 , (3.0 + 1.0) ) + expr {hypot ( 3 , (3.0 + 1.0) )} } 5.0 test expr-old-33.4 {conversions and fancy args to math functions} mathfunc { format %.6g [expr cos(acos(0.1))] diff -Nru jimtcl-0.79+dfsg0/tests/expr.test jimtcl-0.81+dfsg0/tests/expr.test --- jimtcl-0.79+dfsg0/tests/expr.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/expr.test 2021-11-27 23:06:54.000000000 +0000 @@ -11,7 +11,7 @@ } {1} test expr-1.3 "Hex values" { - set mask1 [expr 0x4050 & 0x0CCC] + set mask1 [expr {0x4050 & 0x0CCC}] } {64} test expr-1.4 "Ternary operator - true" { @@ -142,4 +142,17 @@ set a } {2} +test expr-5.1 "Not" { + lmap x {1 0 true false on off yes no} { expr {!$x} } +} {0 1 0 1 0 1 0 1} + +test expr-5.2 "Not" -body { + expr {!this} +} -returnCodes error -result {syntax error in expression: "!this"} + +test expr-5.3 {boolean in expression} { + expr {true ? 4 : 5} +} {4} + + testreport diff -Nru jimtcl-0.79+dfsg0/tests/filecopy.test jimtcl-0.81+dfsg0/tests/filecopy.test --- jimtcl-0.79+dfsg0/tests/filecopy.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/filecopy.test 2021-11-27 23:06:54.000000000 +0000 @@ -5,6 +5,8 @@ needs cmd exec needs cmd parray tclcompat +testConstraint unix [expr {$tcl_platform(platform) eq "unix"}] + cd [file dirname [info script]] file mkdir tempdir @@ -68,6 +70,31 @@ file size tempfile } 16 +test file-tempfile-1.1 {file tempfile - simple} { + set f [file tempfile] + set ret [file exists $f] + file delete $f + set ret +} {1} + +# Note that Windows doesn't provide much control over the tempfile. +# Only the first 3 chars of the pattern are used, so ignore these tests on that platform + +test file-tempfile-1.2 {file tempfile with pattern} unix { + set f [file tempfile /tmp/file-tempfile.XXXXXX] + set ret [file exists $f] + file delete $f + set ret +} {1} + +test file-tempfile-1.3 {file tempfile with invalid path} -constraints unix -body { + set f [file tempfile /doesnotexist/file-tempfile.XXXXXX] + puts $f + set ret [file exists $f] + file delete $f + set $f +} -returnCodes error -match glob -result {/doesnotexist/file-tempfile.*} + file delete tempfile file delete --force tempdir diff -Nru jimtcl-0.79+dfsg0/tests/file.test jimtcl-0.81+dfsg0/tests/file.test --- jimtcl-0.79+dfsg0/tests/file.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/file.test 2021-11-27 23:06:54.000000000 +0000 @@ -1,6 +1,16 @@ source [file dirname [info script]]/testing.tcl needs cmd file +catch {file link} msg +testConstraint filelink [string match "wrong # args:*" $msg] +catch {file lstat} msg +testConstraint filelstat [string match "wrong # args:*" $msg] +testConstraint unix [expr {$tcl_platform(platform) eq "unix"}] +if {[testConstraint jim]} { + testConstraint mtimeset [expr {!$tcl_platform(bootstrap)}] +} else { + testConstraint mtimeset 1 +} test join-1.1 "One name" { file join abc @@ -117,6 +127,274 @@ file dirname abc/ } {.} +test dirname-1.5 ".." { + file dirname .. +} {.} + +test dirname-1.6 "abc/.." { + file dirname abc/.. +} {abc} + +test dirname-1.7 "../abc" { + file dirname ../abc +} {..} + +test stat-1.1 {file stat usage} -body { + file stat +} -returnCodes error -match glob -result {wrong # args: should be "file stat name*"} + +test stat-1.2 {file stat usage} -body { + file stat nonexistent a +} -returnCodes error -match glob -result {could not read "nonexistent": *} + +test stat-1.3 {file stat} { + unset -nocomplain a + file stat [info script] a + set a(type) +} {file} + +test stat-1.4 {file stat update array} { + set a(type) bogus + file stat [info nameofexecutable] a + set a(type) +} {file} + +test stat-1.5 {file stat update bad array} -body { + unset -nocomplain a + # invalid dict/array + set a {1 2 3} + file stat [info nameofexecutable] a +} -returnCodes error -result {can't set "a(dev)": variable isn't array} + +test stat-1.7 {file stat no variable} jim { + set a [file stat [info script]] + set a(type) +} {file} + +test ext-1.1 {file ext} -body { + file ext +} -returnCodes error -result {wrong # args: should be "file extension name"} + +test ext-1.2 {file ext basic} { + file ext abc.def +} {.def} + +test ext-1.3 {file ext path} { + file ext 123/abc.def +} {.def} + +test ext-1.4 {file ext noext} { + file ext abc +} {} + +test ext-1.5 {file ext noext} { + file ext abc.def/ghi +} {} + +test rootname-1.1 {file rootname} -body { + file rootname +} -returnCodes error -result {wrong # args: should be "file rootname name"} + +test rootname-1.2 {file rootname basic} -body { + file rootname abc +} -result {abc} + +test rootname-1.3 {file rootname basic} -body { + file rootname abc/def +} -result {abc/def} + +test rootname-1.4 {file rootname basic} -body { + file rootname abc.c +} -result {abc} + +test rootname-1.5 {file rootname basic} -body { + file rootname abc/def.c +} -result {abc/def} + +test rootname-1.6 {file rootname odd cases} -body { + file rootname abc/def.c/ghi +} -result {abc/def.c/ghi} + +test rootname-1.7 {file rootname odd cases} -body { + file rootname abc/def.c/ +} -result {abc/def.c/} + +test rootname-1.8 {file rootname odd cases} -body { + file rootname abc/def.c// +} -result {abc/def.c//} + +test readable-1.1 {file readable} { + file readable [info script] +} {1} + +test writable-1.1 {file writable} -body { + set name tmp.[pid] + makeFile testing $name + file writable $name +} -result 1 -cleanup { + file delete $name +} + +test rename-1.1 {file rename usage} -body { + file rename +} -returnCodes error -match glob -result {wrong # args: should be *} + +test rename-1.2 {file rename usage} -body { + file rename -badarg name1 name2 +} -returnCodes error -match glob -result {*} + +test rename-1.1 {file rename, target exists} -body { + set name1 tmp.[pid] + set name2 tmp2.[pid] + makeFile testing $name1 + makeFile testing2 $name2 + file rename $name1 $name2 +} -returnCodes error -match glob -result {error renaming *} + +test rename-1.2 {file rename -force, target exists} -body { + file rename -force $name1 $name2 + list [file exists $name1] [file exists $name2] +} -result {0 1} -cleanup { + file delete $name2 +} + +test link-1.1 {file link usage} -constraints filelink -body { + file link +} -returnCodes error -match glob -result {wrong # args: should be "file link*} + +test link-1.2 {file hard link} -constraints filelink -body { + set name tmp.[pid] + file link $name [info script] + file exists $name +} -result {1} -cleanup { + file delete $name +} + +test link-1.3 {file hard link} -constraints filelink -body { + set name tmp.[pid] + file link -hard $name [info script] + file exists $name +} -result {1} -cleanup { + file delete $name +} + +test link-1.4 {file sym link} -constraints filelink -body { + set name tmp.[pid] + file link -sym $name [info script] + list [file exists $name] [file tail [file readlink $name]] +} -result {1 file.test} -cleanup { + file delete $name +} + +test link-1.5 {file readlink, bad link} -constraints filelink -body { + file readlink [info script] +} -returnCodes error -match glob -result {could not read*link "*file.test": *} + +test link-1.6 {file link badopt} -constraints filelink -body { + file link -bad name1 name2 +} -returnCodes error -match glob -result {bad * "-bad": must be *} + +test lstat-1.1 {file lstat} -constraints filelstat -body { + file lstat +} -returnCodes error -match glob -result {wrong # args: should be "file lstat name *} + +test lstat-1.2 {file lstat} -constraints filelstat -body { + file lstat nonexistent ls +} -returnCodes error -match glob -result {could not read "nonexistent": *} + +test lstat-1.3 {file lstat} -constraints {filelink filelstat} -body { + set name tmp.[pid] + file link -sym $name [info script] + unset -nocomplain s ls + file lstat $name ls + file stat [info script] s + list $ls(type) $s(type) +} -match glob -result {link file} -cleanup { + file delete $name +} + +test type-1.1 {file type} { + file type [info script] +} {file} + +test type-1.2 {file type} { + file type [file dirname [info script]] +} {directory} + +test type-1.2 {file type} -body { + file type nonexistent +} -returnCodes error -match glob -result {could not read "nonexistent": *} + +test isfile-1.1 {file isfile} -body { + file isfile +} -returnCodes error -result {wrong # args: should be "file isfile name"} + +test isfile-1.2 {file isfile} { + file isfile [info script] +} {1} + +test isfile-1.3 {file isfile} { + file isfile [file dirname [info script]] +} {0} + +test size-1.1 {file size} -body { + file size +} -returnCodes error -result {wrong # args: should be "file size name"} + +test size-1.2 {file size} -body { + file size nonexistent +} -returnCodes error -match glob -result {could not read "nonexistent":*} + +test size-1.3 {file size} { + set size [file size [info script]] + file stat [info script] s + expr {$size - $s(size)} +} {0} + +test mtime-1.1 {file mtime} -body { + file mtime +} -returnCodes error -result {wrong # args: should be "file mtime name ?time?"} + +test mtime-1.2 {file mtime} -body { + file mtime nonexistent +} -returnCodes error -match glob -result {could not read "nonexistent":*} + +test mtime-1.3 {file mtime} -body { + file mtime [info script] bad +} -returnCodes error -result {expected integer but got "bad"} + +test mtime-1.4 {file mtime} { + set mtime [file mtime [info script]] + file stat [info script] s + if {$mtime != $s(mtime)} { + error "mtime was $mtime but s(mtime) was $s(mtime)" + } +} {} + +test mtime-1.5 {file mtime} -constraints {mtimeset unix} -body { + set name tmp.[pid] + makeFile testing $name + set t [file mtime [info script]] + file mtime $name $t + expr {$t - [file mtime $name]} +} -result {0} -cleanup { + file delete $name +} + +test atime-1.1 {file atime} -body { + file atime +} -returnCodes error -match glob -result {wrong # args: should be "file atime name*} + +test atime-1.2 {file atime} -body { + file atime nonexistent +} -returnCodes error -match glob -result {could not read "nonexistent":*} + +test atime-1.3 {file atime} { + set atime [file atime [info script]] + file stat [info script] s + expr {$atime - $s(atime)} +} {0} + # These tests are courtesy of picol test file.12.1 "picol test" {file dirname /foo/bar/grill.txt} /foo/bar diff -Nru jimtcl-0.79+dfsg0/tests/format.test jimtcl-0.81+dfsg0/tests/format.test --- jimtcl-0.79+dfsg0/tests/format.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/format.test 2021-11-27 23:06:54.000000000 +0000 @@ -419,7 +419,7 @@ set a 0.0000000000001 set b 0.00000000000001 set c 0.00000000000000001 - set d [expr $a + $b + $c] + set d [expr {$a + $b + $c}] format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d } {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001} test format-13.2 {tcl_precision fuzzy comparison} { @@ -430,7 +430,7 @@ set a 0.000000000001 set b 0.000000000000005 set c 0.0000000000000008 - set d [expr $a + $b + $c] + set d [expr {$a + $b + $c}] format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d } {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580} test format-13.3 {tcl_precision fuzzy comparison} { @@ -439,7 +439,7 @@ catch {unset c} set a 0.00000000000099 set b 0.000000000000011 - set c [expr $a + $b] + set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c } {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100} test format-13.4 {tcl_precision fuzzy comparison} { @@ -448,7 +448,7 @@ catch {unset c} set a 0.444444444444 set b 0.33333333333333 - set c [expr $a + $b] + set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c } {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300} test format-13.5 {tcl_precision fuzzy comparison} { @@ -457,7 +457,7 @@ catch {unset c} set a 0.444444444444 set b 0.99999999999999 - set c [expr $a + $b] + set c [expr {$a + $b}] format {%0.10f %0.12f %0.15f} $c $c $c } {1.4444444444 1.444444444444 1.444444444443990} test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} { @@ -486,7 +486,7 @@ append b $a } for {set i 290} {$i < 400} {incr i} { - test format-15.[expr $i -290] {testing MAX_FLOAT_SIZE} { + test format-15.[expr {$i -290}] {testing MAX_FLOAT_SIZE} { format {%s} $b } $b append b "x" diff -Nru jimtcl-0.79+dfsg0/tests/history.test jimtcl-0.81+dfsg0/tests/history.test --- jimtcl-0.79+dfsg0/tests/history.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/history.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,45 @@ +source [file dirname [info script]]/testing.tcl + +needs cmd history + +test history-1.1 {history usage} -body { + history +} -returnCodes error -result {wrong # args: should be "history command ..." +Use "history -help ?command?" for help} + +test history-1.2 {history -help} -body { + history -help +} -result {Usage: "history command ... ", where command is one of: add, completion, getline, keep, load, save, show} + +test history-1.2 {history add} { + history add line1 + history add "line2 next" + set name tmp.[pid] + history save $name + set f [open $name] + set lines [split [string trimright [read $f]] \n] +} {line1 {line2 next}} + +test history-1.3 {history load} { + history load $name +} {} + +test history-1.4 {history completion usage} -body { + history completion +} -returnCodes error -result {wrong # args: should be "history completion command"} + +test history-1.5 {history completion} { + history completion command +} {} + +test history-1.6 {history completion} { + history completion {} +} {} + +catch { + file delete $name +} + +# Can't really test history add, show, setcompletion + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/infoframe.test jimtcl-0.81+dfsg0/tests/infoframe.test --- jimtcl-0.79+dfsg0/tests/infoframe.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/infoframe.test 2021-11-27 23:06:54.000000000 +0000 @@ -2,9 +2,9 @@ needs constraint jim proc a {n} { if {$n eq "trace"} { - stacktrace + basename-stacktrace [stacktrace] } else { - info frame $n + basename-stacktrace [info frame $n] } } diff -Nru jimtcl-0.79+dfsg0/tests/interactive.test jimtcl-0.81+dfsg0/tests/interactive.test --- jimtcl-0.79+dfsg0/tests/interactive.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/interactive.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,138 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +needs cmd socket + +package require expect + +set saveenv $env + +# Make sure we start with an empty history +set env(HOME) [pwd] +file delete .jim_history + +# spawn the process to be used for testing +set p [expect::spawn [list [info nameofexecutable]]] + +set env $saveenv + +$p timeout 1 +# Turn on echo since we get echo with linenoise anyway +$p tty echo 1 + +proc wait-for-prompt {p} { + $p expect {\. } +} + +# Start with an empty history +file delete test_history +wait-for-prompt $p +$p send "history load test_history\r" +# skip echoed output +$p expect {\r\n} +wait-for-prompt $p + +test interactive-1.1 {basic command} -body { + $p send "lsort \[info commands li*\]\r" + # skip echoed output + $p expect {\r\n} + # get command result + $p expect {\r\n} + $p before +} -result {lindex linsert list} -cleanup { + wait-for-prompt $p +} + +test interactive-1.2 {command line completion} { + set check 0 + set failed 0 + $p send "li\t" + $p expect {lindex} { incr check } TIMEOUT { incr failed } + if {!$failed} { + $p send "\t" + $p expect {linsert} { incr check } + $p send "\t" + $p expect {list} { incr check } + $p send \r + } + $p expect {\r\n} + wait-for-prompt $p + + list $check $failed +} {3 0} + +test interactive-1.3 {history show} -body { + $p send "history show\r" + $p expect {\r\n} + $p expect {history show\r\n} + string cat [$p before] [$p after] +} -result " 1 history load test_history\r\n 2 lsort \[info commands li*\]\r\n 3 list\r\n 4 history show\r\n" -cleanup { + wait-for-prompt $p +} + +test interactive-1.4 {history getline} -body { + $p send "history getline {PROMPT> }\r" + $p expect {\r\n} + sleep 0.25 + $p send "abc\bd\x01e\r" + $p expect {\r\n} + $p expect {\r\n} + $p before +} -result {eabd} -cleanup { + wait-for-prompt $p +} + +test interactive-1.4 {history getline} -body { + $p send "set len \[history getline {PROMPT> } buf\]\r" + $p expect {\r\n} + sleep 0.25 + $p send "abcde\r" + $p expect {\r\n} + $p expect {\r\n} + sleep 0.25 + $p wait-for-prompt + $p send "list \$len \$buf\r" + $p expect {\r\n} + $p expect {\r\n} + $p before +} -result {5 abcde} -cleanup { + wait-for-prompt $p +} + +test interactive-1.5 {insert wide character} -constraints utf8 -body { + $p send "set x a\u1100b" + # now arrow left twice over the wide char and insert another char + $p send \x1bOD + $p send \x1bOD + $p send y + $p send \r + $p expect {\r\n} + sleep 0.25 + $p expect {\r\n} + $p before +} -result ay\u1100b -cleanup { + wait-for-prompt $p +} + +test interactive-1.6 {insert utf-8 combining character} -constraints utf8 -body { + $p send "set x x\u0300" + # now arrow left twice over the combining char and "x" and insert another char + $p send \x1bOD + $p send \x1bOD + $p send y + $p send \r + $p expect {\r\n} + sleep 0.25 + $p expect {\r\n} + $p before +} -result yx\u0300 -cleanup { + wait-for-prompt $p +} + +# send ^D to cause the interpeter to exit +$p send \x04 +sleep 0.25 +$p expect EOF +$p close + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/intexpr.test jimtcl-0.81+dfsg0/tests/intexpr.test --- jimtcl-0.79+dfsg0/tests/intexpr.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/intexpr.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,133 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim + +# There are two kinds of commands that use (safe) integer expressions: +# direct: loop, range, incr, string repeat, lrepeat, pack, unpack, rand +# index: lindex, linsert, lreplace, lset, lrange, lsort, regexp, regsub, string index,first,last,range +# +# Since they are all identical under the covers, we only test one from each group here, +# string repeat and string index + +test intexpr-1.1 {string repeat} { + string repeat a 2+1 +} {aaa} + +test intexpr-1.2 {string repeat} { + string repeat a 2-1 +} {a} + +test intexpr-1.3 {string repeat} { + string repeat a 2*3 +} {aaaaaa} + +test intexpr-1.4 {string repeat - function calls} { + string repeat a int(abs(-2)) +} {aa} + +test intexpr-1.4 {string repeat - expanded var} { + set n 3 + string repeat a $n+1 +} {aaaa} + +test intexpr-1.5 {string repeat - no subst var} -body { + set n 3 + string repeat a {$n+1} +} -returnCodes error -result {expected integer expression but got "$n+1"} + +test intexpr-1.6 {string repeat - no subst cmd} -body { + string repeat a {[string length xy]+1} +} -returnCodes error -result {expected integer expression but got "[string length xy]+1"} + +test intexpr-1.6 {string repeat - no subst dictvar} -body { + set b(3) 4 + string repeat a {$b(4)} +} -returnCodes error -result {expected integer expression but got "$b(4)"} + +test intexpr-1.7 {string repeat - no subst dictvar} -body { + set b(3) 4 + string repeat a {$b(4)+2} +} -returnCodes error -result {expected integer expression but got "$b(4)+2"} + +set str abcdefghi +test intexpr-2.1 {string index} { + string index $str 2+1 +} {d} + +test intexpr-2.2 {string index} { + string index $str 2-1 +} {b} + +test intexpr-2.3 {string index} { + string index $str 2*3 +} {g} + +test intexpr-2.4 {string index - function calls} { + string index $str int(abs(-2)) +} {c} + +test intexpr-2.4 {string index - expanded var} { + set n 3 + string index $str $n+1 +} {e} + +test intexpr-2.5 {string index - no subst var} -body { + set n 3 + string index $str {$n+1} +} -returnCodes error -result {bad index "$n+1": must be intexpr or end?[+-]intexpr?} + +test intexpr-2.6 {string index - no subst cmd} -body { + string index $str {[string length xy]+1} +} -returnCodes error -result {bad index "[string length xy]+1": must be intexpr or end?[+-]intexpr?} + +test intexpr-2.6 {string index - no subst dictvar} -body { + set b(3) 4 + string index $str {$b(4)} +} -returnCodes error -result {bad index "$b(4)": must be intexpr or end?[+-]intexpr?} + +test intexpr-2.7 {string index - no subst dictvar} -body { + set b(3) 4 + string index $str {$b(4)+2} +} -returnCodes error -result {bad index "$b(4)+2": must be intexpr or end?[+-]intexpr?} + +test intexpr-3.1 {string index} { + string index $str end-2+1 +} {h} + +test intexpr-3.2 {string index} { + string index $str end-2-1 +} {f} + +test intexpr-3.3 {string index} { + string index $str end-2*3 +} {c} + +test intexpr-3.4 {string index - function calls} { + string index $str end+int(-2) +} {g} + +test intexpr-3.4 {string index - expanded var} { + set n 3 + string index $str end-($n+1) +} {e} + +test intexpr-3.5 {string index - no subst var} -body { + set n 3 + string index $str {end-($n+1)} +} -returnCodes error -result {bad index "end-($n+1)": must be intexpr or end?[+-]intexpr?} + +test intexpr-3.6 {string index - no subst cmd} -body { + string index $str {end-[string length xy]+1} +} -returnCodes error -result {bad index "end-[string length xy]+1": must be intexpr or end?[+-]intexpr?} + +test intexpr-3.6 {string index - no subst dictvar} -body { + set b(3) 4 + string index $str {end-$b(4)} +} -returnCodes error -result {bad index "end-$b(4)": must be intexpr or end?[+-]intexpr?} + +test intexpr-3.7 {string index - no subst dictvar} -body { + set b(3) -4 + string index $str {end+$b(4)-2} +} -returnCodes error -result {bad index "end+$b(4)-2": must be intexpr or end?[+-]intexpr?} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/jiminterp.test jimtcl-0.81+dfsg0/tests/jiminterp.test --- jimtcl-0.79+dfsg0/tests/jiminterp.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/jiminterp.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,27 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +needs cmd interp + +test interp-1.0 {interp bad args} -body { + interp arg +} -returnCodes error -result {wrong # args: should be "interp"} + +test interp-1.1 {interp alias} { + set i [interp] + $i alias subincr incr + $i eval { set x 0 } + $i eval { subincr x } + $i eval { subincr x } +} {2} + +test interp-1.2 {interp alias delete} { + $i eval { rename subincr "" } +} {} + +test interp-1.3 {interp delete } { + $i alias subincr2 incr + $i delete +} {} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/jimsh.test jimtcl-0.81+dfsg0/tests/jimsh.test --- jimtcl-0.79+dfsg0/tests/jimsh.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/jimsh.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,56 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim + +test jimsh-1.1 {jimsh --help} -body { + exec [info nameofexecutable] --help +} -match glob -result {jimsh version *Usage: *} + +test jimsh-1.2 {jimsh -} { + exec [info nameofexecutable] - << {puts $(1 + 2)} +} {3} + +test jimsh-1.3 {jimsh - arg list} jim { + exec [info nameofexecutable] - arg list << {puts [join $argv]} +} {arg list} + +test jimsh-1.4 {jimsh -e} { + exec [info nameofexecutable] -e {expr {4 + 5}} +} {9} + +test jimsh-1.4 {jimsh -e with args} { + exec [info nameofexecutable] -e {set argv} arg1 arg2 +} {arg1 arg2} + +test jimsh-1.5 {jimsh --version} { + exec [info nameofexecutable] --version +} [info version] + +test jimsh-1.6 {jimsh -e with error} -body { + exec [info nameofexecutable] -e blah +} -returnCodes error -result {invalid command name "blah"} + +test jimsh-1.7 {jimsh prompt} -body { + exec [info nameofexecutable] << "set x 3\nincr x\nexit \$x\n" +} -returnCodes error -match glob -result {Welcome to Jim version * +. 3 +. 4 +. } + +test jimsh-1.8 {jimsh prompt - error} -body { + exec [info nameofexecutable] << "blah\n" +} -match glob -result {Welcome to Jim version * +. invalid command name "blah" +\[error\] . } + +test jimsh-1.9 {jimsh prompt - error} -body { + exec [info nameofexecutable] << "throw 99\n" +} -match glob -result {Welcome to Jim version * +. \[99\] . } + +test jimsh-1.10 {jimsh prompt - continuation} -body { + exec [info nameofexecutable] << "set x {\nabc\n}\n" +} -match glob -result "Welcome to Jim version *\n. {> {> \nabc\n\n. " + + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/jim.test jimtcl-0.81+dfsg0/tests/jim.test --- jimtcl-0.79+dfsg0/tests/jim.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/jim.test 2021-11-27 23:06:54.000000000 +0000 @@ -11,8 +11,7 @@ needs constraint jim catch {package require regexp} -testConstraint regexp [expr {[info commands regexp] ne {}}] -testConstraint lambda [expr {[info commands ref] ne {}}] +testCmdConstraints regexp readdir lambda ################################################################################ # SET @@ -372,7 +371,7 @@ list [catch { eval [list $lset a [list 2a2] w] } msg] $msg -} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}} test lset-4.3 {lset, not compiled, 3 args, index out of range} { set a {x y z} @@ -407,7 +406,7 @@ list [catch { eval [list $lset a 2a2 w] } msg] $msg -} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}} test lset-4.9 {lset, not compiled, 3 args, index out of range} { set a {x y z} @@ -543,7 +542,7 @@ test lset-8.3 {lset, not compiled, bad second index} { set a {{b c} {d e}} list [catch {eval [list $lset a 0 2a2 f]} msg] $msg -} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}} test lset-8.5 {lset, not compiled, second index out of range} { set a {{b c} {d e} {f g}} @@ -1270,11 +1269,10 @@ set i 25 incr i 000012345 ;# a decimal literal } 12370 -test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} { +test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body { set i 25 - catch {incr i 1a} msg - set msg -} {expected integer but got "1a"} + incr i 1a +} -returnCodes error -match glob -result {expected integer *but got "1a"} test incr-1.25 {TclCompileIncrCmd: too many arguments} { set i 10 @@ -1283,10 +1281,10 @@ } {wrong # args: should be "incr varName ?increment?"} -test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} { +test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body { set x " - " - list [catch {incr x 1} msg] $msg -} {1 {expected integer but got " - "}} + incr x 1 +} -returnCodes error -match glob -result {expected integer *but got " - "} test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} { catch {unset array} @@ -1489,12 +1487,11 @@ set i 25 $z i 000012345 ;# an octal literal } 12370 -test incr-2.24 {incr command (not compiled): increment given, formatted int != int} { +test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body { set z incr set i 25 - catch {$z i 1a} msg - set msg -} {expected integer but got "1a"} + $z i 1a +} -returnCodes error -match glob -result {expected integer *but got "1a"} test incr-2.25 {incr command (not compiled): too many arguments} { set z incr @@ -1503,11 +1500,11 @@ set msg } {wrong # args: should be "incr varName ?increment?"} -test incr-2.29 {incr command (not compiled): runtime error, bad variable value} { +test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body { set z incr set x " - " - list [catch {$z x 1} msg] $msg -} {1 {expected integer but got " - "}} + $z x 1 +} -returnCodes error -match glob -result {expected integer *but got " - "} ################################################################################ # LLENGTH @@ -1558,7 +1555,7 @@ test lindex-2.4 {malformed index list} { set x \{ list [catch { eval [list $lindex {a b c} $x] } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ intexpr\ or\ end?\[+-\]intexpr?} # Indices that are integers or convertible to integers @@ -1617,7 +1614,7 @@ test lindex-4.8 {bad integer, not octal} { set x end-0a2 list [catch { eval [list $lindex {a b c} $x] } result] $result -} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "end-0a2": must be intexpr or end?[+-]intexpr?}} #test lindex-4.9 {incomplete end} { # set x en @@ -1627,11 +1624,11 @@ test lindex-4.10 {incomplete end-} { set x end- list [catch { eval [list $lindex {a b c} $x] } result] $result -} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "end-": must be intexpr or end?[+-]intexpr?}} test lindex-5.1 {bad second index} { list [catch { eval [list $lindex {a b c} 0 0a2] } result] $result -} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "0a2": must be intexpr or end?[+-]intexpr?}} test lindex-5.2 {good second index} { eval [list $lindex {{a b c} {d e f} {g h i}} 1 2] @@ -1681,7 +1678,7 @@ test lindex-10.4 {malformed index list} { set x \{ list [catch { lindex {a b c} $x } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ intexpr\ or\ end?\[+-\]intexpr?} # Indices that are integers or convertible to integers @@ -1761,16 +1758,16 @@ test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result -} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "end-0a2": must be intexpr or end?[+-]intexpr?}} test lindex-12.10 {incomplete end-} { set x end- list [catch { lindex {a b c} $x } result] $result -} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "end-": must be intexpr or end?[+-]intexpr?}} test lindex-13.1 {bad second index} { list [catch { lindex {a b c} 0 0a2 } result] $result -} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "0a2": must be intexpr or end?[+-]intexpr?}} test lindex-13.2 {good second index} { catch { @@ -1838,6 +1835,34 @@ lindex {a b c} } {a b c} +test lindex-18.1 {multiple +n} { + lindex {a b c d e f g} 1+1+1 +} {d} + +test lindex-18.2 {multiple +n/-n} { + lindex {a b c d e f g} 1+2-1 +} {c} + +test lindex-18.3 {end + multiple +n/-n} { + lindex {a b c d e f g} end-1-1 +} {e} + +test lindex-18.3 {end + multiple +n/-n} { + lindex {a b c d e f g} end-3+1 +} {e} + +test lindex-18.4 {multiple +/- in error} -body { + lindex {a b c d e f g} 1-x+3 +} -returnCodes error -match glob -result "bad index*" + +test lindex-18.5 {multiple +/- in error} -body { + lindex {a b c d e f g} 2-1+4x +} -returnCodes error -match glob -result "bad index*" + +test lindex-18.6 {multiple +/- in error} -body { + lindex {a b c d e f g} end-3x-1 +} -returnCodes error -match glob -result "bad index*" + catch { unset lindex} catch { unset minus } @@ -1951,7 +1976,7 @@ catch {unset x} foreach {12.0} {a b c} { set x 12.0 - set x [expr $x + 1] + set x [expr {$x + 1}] } set x } 13.0 @@ -2025,7 +2050,7 @@ } {1 {wrong # args: should be "string last subString string ?index?"}} test string-7.2 {string last, bad args} { list [catch {string last a b c} msg] $msg -} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "c": must be intexpr or end?[+-]intexpr?}} 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 ?index?"}} @@ -2501,6 +2526,15 @@ list [catch {switch -foo a b c} msg] $msg } {1 {bad option "-foo": must be -exact, -glob, -regexp, -command procname or --}} +test switch-3.8 {switch -regexp with option-like pattern} regexp { + switch -regexp -- -def { + -abc {concat first} + -def {concat second} + -ghi {concat third} + default {concat none} + } +} second + test switch-4.1 {error in executed command} { list [catch {switch a a {error "Just a test"} default {expr 1}} msg] \ $msg @@ -3340,7 +3374,7 @@ test range-2.0 {foreach range test} { set k 0 foreach {x y} [range 100] { - incr k [expr {$x*$y}] + incr k [expr {$x*$y}] } set k } {164150} @@ -3349,8 +3383,8 @@ set k 0 set trash {} foreach {x y} [range 100] { - incr k [expr {$x*$y}] - lappend trash $x $y + incr k [expr {$x*$y}] + lappend trash $x $y } set trash {} set k @@ -3359,7 +3393,7 @@ test range-2.2 {range element shimmering test} { set k {} foreach x [range 0 10] { - append k [llength $x] + append k [llength $x] } set k } {1111111111} @@ -3385,12 +3419,40 @@ set trash {} set r [range 100] for {set i 0} {$i < [llength $r]} {incr i 2} { - incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}] + incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}] } set trash {} set k } {164150} +test range-6.1 {range} -body { + range +} -returnCodes error -result {wrong # args: should be "range ?start? end ?step?"} + +test range-6.2 {range} -body { + range foo +} -returnCodes error -match glob -result {expected integer *but got "foo"} + +test range-6.3 {range} -body { + range 2 bar +} -returnCodes error -match glob -result {expected integer *but got "bar"} + +test range-6.4 {range} -body { + range 2 4 foo +} -returnCodes error -match glob -result {expected integer *but got "foo"} + +test range-6.5 {range} -body { + range 10 0 +} -returnCodes error -result {Invalid (infinite?) range specified} + +test range-6.6 {range} -body { + range 2 4 0 +} -returnCodes error -result {Invalid (infinite?) range specified} + +test range-6.7 {range} -body { + range 2 4 -2 +} -returnCodes error -result {Invalid (infinite?) range specified} + ################################################################################ # SCOPE ################################################################################ @@ -3472,6 +3534,45 @@ catch {unset sum; unset err; unset i} ################################################################################ +# ENV +################################################################################ +test env-1.1 {env} -body { + env abc def ghi +} -returnCodes error -result {wrong # args: should be "env varName ?default?"} + +test env-1.2 {env} -body { + env DOES_NOT_EXIST abc +} -result {abc} + +test env-1.3 {env} -body { + env DOES_NOT_EXIST +} -returnCodes error -result {environment variable "DOES_NOT_EXIST" does not exist} + +################################################################################ +# READDIR +################################################################################ +test readdir-1.1 {readdir usage} -body { + readdir +} -returnCodes error -result {wrong # args: should be "readdir ?-nocomplain? dirPath"} + +test readdir-1.2 {readdir basic} -body { + expr {"jim.test" in [readdir [file dirname [info script]]]} +} -result {1} + +test readdir-1.3 {readdir basic} -body { + expr {"jim.test" in [readdir -nocomplain [file dirname [info script]]]} +} -result {1} + +test readdir-1.4 {readdir errors} -body { + readdir nonexistent +} -returnCodes error -result {No such file or directory} + +test readdir-1.4 {readdir -nocomplain} -body { + readdir -nocomplain nonexistent +} -result {} + + +################################################################################ # JIM REGRESSION TESTS ################################################################################ test regression-1.0 {Rename against procedures with static vars} { diff -Nru jimtcl-0.79+dfsg0/tests/key.pem jimtcl-0.81+dfsg0/tests/key.pem --- jimtcl-0.79+dfsg0/tests/key.pem 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/key.pem 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,51 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIJKgIBAAKCAgEA0T9HMb5b2WZDIAF7+7KZzwAEiXC5misVrY1gmlwvLlSVx1pX +Kx5KrFpwkBMfDs1Zsi03/D46N+kViOmSJY/h5nxpiTdbs1Gld2b1RqFbnXcLmx7e +WVXXouLDcmzoJM1Y7vh26e9j3Uy4Bsew7zfxgnWmbfOA9Sg/rHamQFfJ+Ov9Nglk +AoGPwdIiDWc4+hkKD6HL3B72m3VyD4crDSuTm2vFqUDhXk+Jw3clNQYXHQrOSpDK +st1qPQtEDTQbrmKhSN6jMBRwcwfo39lCZLN02jEfOC2bwHPe+VgcyfCzWgfKHtPl +hqqanSIndDSAc6aF5hzI1vlT2dZNmSWDZ6QBrwharh25QXcnQhDr/9DyHIjgvojR +OsOiSaT4pVvJRBsVm7N/7kVQKvNdbwB8itz+ubLlb5SYahlZNBMpE9RqgchwAwe0 +SpjILMBHI90/H89SrZPZ4rMitZiIq5/3mBFEy/7Xio/G5jw/Gp3cHa6SMf/6cqhl +l7binB8s8Yd5c8RvdNunczCobKmbnTMDRdsnjnvWFmiaPJZUdcOtftxUCxYP2tEj +apQL8kjC+K4MjCGkde/5lrd8+yRY6GK6zixxfYb1jka/NFdXBaws4gm8amrsFstk +Y3K2GqrVh44/sG7BNqsl4hxkqyHryay7B413+KUrkiET4PqwSHgtJHPayAMCAwEA +AQKCAgEApOLjPCyP/jkaLg9dXtK3ZynRaWh9qSHIXFFqzVhVCYI34Last9qP508B +IlcfAzAIPWJqmoeCouo2QQQlWRoPXeut0iXgSebNp9Bm+ThPlD7p01u4xNbjLITa +lMGDEPUL3ovGUMOGgy1gWl9jaq4/zpjdBAl9FjKYMlPw4AUNr+xuRPWTbHIiEQ6A +LOWpPVMb3YOWvCdeFtSug9P0tdUf5LpBMQViUkoE+hVaKXVaI1WPh6yfPeFCRUYq +Yukr4vfvthdSqqGAlvSlqjdunSHYs9M/kapG8JmeHAg171+QRSKcQDyjwsGPQsFW +K7jve7K+Er2d+eDRFXhM/6BS8wmHFLP5BtHY/XCCZdjcJShIrGWK/Arepzh5TPpe +lIriZBzFBdtLNDaVs0Fj7C+r5ERYulgrF8gwEfPXxFen4vp4gjP3fRnApXgLfEGu +2Cj7SR62nZrRWKBuOYhaoVGt1zdoP7mmcL32/Kg78ItteaNXG07ICogXBoTl0Tj0 +N0wPpFG280amcJLB2tSwYyiIF53XyNazKxhgpBHnt1/y+peQfZadncQ/nImmM0f6 +GTql3ToEMKj9V3nrYUQhRVEmltCrfJA8pVjFJkp0AjlyZOf/FgcSFNvWbdn0t6vE +EOPU6RklpK0X0Go7B3ywOEqAu51oxo0QgUdRe6v2nzv7Xeuh9FkCggEBAPUV6JTg +uqjWxq7XNA3RljCy8NPzTsT7AS7XwLBD/+JcICXjQQ2SVqMzx7SftGucGw6/8GKx +HRXwp67k73iifiiQ7f1xOsXXgVs7aDg1MT7UE9KOVuY0r74P3No13nSfNYzOMBjh +a+FqKO5v8yjZjNwT5ghtHluJqXPQPMeKYzR3ngNlFRzW9cfDQspiHdTSpu9gFE02 +iSug9SNxMjRDiWsqBC14qu3S3ynaU5UuKhqw5CVSRj/Y7pN94b01tVXe4Szcf/U0 +HXzg33jlf1QshwsdcBXcGpkB5ijtp6koQuAKRHjxeqcpMKIPpxzratlWBPeynvX7 +xO+bDultW4z8tr0CggEBANqQy30ZMM64v39bo04cQNrIMJd2ez1c/lqysneQwIuK +1ALfRJbN74/Zy+vlx9VH6tKT2i5o1FP1Nd5BKiRGLd3bTLE+UlweUWrZoJbyz7ns +IuLqGhw9Qy9SaqCfSyGu9Lmn8blCMVDPf1AggB4fuFHhiT+aBK1AidzDM/Usar2H +D2HwfWP3tKARcyzBnWExiDncUau8oRFdfsYL72kb2P3RvtDtsMRLSFHOdd88o1Us +LSQ+T36U3A2UKCteBndBguN+N7zyUNk7DVpfXILKmFj9nDmoYOFsnctG+TYbRmfr +7G/wKDcEtrmK0tpSOLF5QvowO3qDYaYYYGdK5EPbxb8CggEACDRtjt5fIVvfVucZ +dQT5NDQpX88bafjFN149syjzng5bfSk4ek3V3KzVGLToA1o8hafjUkp/oMZntrEv +WyiFdLI1ZXCu+QSX7gf1Gzyco2/SIhBl1FsbLw+04xE+m0ThNA+LCKozRF6bdDAH +QezWjF+WKd4NUB8xrxDfmAaH/6+peI+fv1Fq9P8Sc1gJi6BpukXLKDKVMQK4cjFN +7vX72byUWzlY75FJq0sF1U6wVihp2t4AQA7xHbrvHbh4k6FchHX1Sq4t9opIsPFt +69F5y+N2ZyTxNwIbRG+AV2djpcByPmJHKuV0HVjMzWkMMK5yiCBQtgdxtlvIigQB +Np0XOQKCAQEAw6yYEUJpONmbz/iJppeS1IwfPKq9QL2tliOftX2pdARxNLUQYfay +v9WcRHBuTJrbN3VZAu2lEhlZBcbPZLRTwejgq1oBQCmAeKmnpRxzLp+iyAYQJDIQ +oSAnB/A0wk4xGLmrplEFd7Sc5W6DZPS+/sdtKbzI7Rb3leZI8Pm4AkAVXHiCuen9 +EsUsmOgp7ub6b9q4X4k7piFPKx1qVG6zAOIz9DaoZ8SCVYMCcj6Gd+1Z6LXEU64P +qDR5FgJSxZeoB+VrH0TNbv34QW1YlFuusxUyNUhym76zMlczK+aVTNqhzcFzL3aP +5GLNzNmJmhHXDcf6p/9Rf/MY88DPxZTPXwKCAQEAt2cxXMiEWfFwWHufqpahl3Aq +C4yf0EFMhBsOmnDYZ4RDYikFGJog7XY+BOEX0NZ2z2ZghwjmQW/Gm14ISQnww97d +uo/MDuUZvf6aAeh6gRmkiejhIXMwuvxRAwm90TFUiJ4yn8LKp2c1XxX8DMHujlzS +cdUKcFO3OL+eLQazM5M+3qxQuAFDTlBf41d3OJjCOuQ9soBy0Gy9yMhtjFVVmKDw +eArA0lZgskLVcI9JH6bPhv7+5+n26OqMlFjtmbNMwqi/lOoyGwst5b2d9oAMkWQi +QW5pi51MaAwVV8q8NdfUv1twD8lpRV8Rwb2k8rmG5FqSwhOsibSwpu8gf4WYow== +-----END RSA PRIVATE KEY----- diff -Nru jimtcl-0.79+dfsg0/tests/linsert.test jimtcl-0.81+dfsg0/tests/linsert.test --- jimtcl-0.79+dfsg0/tests/linsert.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/linsert.test 2021-11-27 23:06:54.000000000 +0000 @@ -82,10 +82,10 @@ } {1 {wrong # args: should be "linsert list index ?element ...?"}} test linsert-2.2 {linsert errors} { list [catch {linsert a b} msg] $msg -} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "b": must be intexpr or end?[+-]intexpr?}} test linsert-2.3 {linsert errors} { list [catch {linsert a 12x 2} msg] $msg -} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "12x": must be intexpr or end?[+-]intexpr?}} test linsert-2.4 {linsert errors} tcl { list [catch {linsert \{ 12 2} msg] $msg } {1 {unmatched open brace in list}} diff -Nru jimtcl-0.79+dfsg0/tests/list.test jimtcl-0.81+dfsg0/tests/list.test --- jimtcl-0.79+dfsg0/tests/list.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/list.test 2021-11-27 23:06:54.000000000 +0000 @@ -83,9 +83,9 @@ proc slowsort list { set result {} - set last [expr [llength $list] - 1] + set last [expr {[llength $list] - 1}] while {$last > 0} { - set minIndex [expr [llength $list] - 1] + set minIndex [expr {[llength $list] - 1}] set min [lindex $list $last] set i [expr $minIndex-1] while {$i >= 0} { @@ -110,4 +110,11 @@ slowsort {fred julie alex carol bill annie} } {alex annie bill carol fred julie} +test list-4.1 {lreverse} { + lreverse {} +} {} +test list-4.2 {lreverse} { + lreverse {1 2 3} +} {3 2 1} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/load.test jimtcl-0.81+dfsg0/tests/load.test --- jimtcl-0.79+dfsg0/tests/load.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/load.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,109 @@ +source [file dirname [info script]]/testing.tcl + +needs cmd load interp + +# In order to test loadable modules we need a working build-jim-ext +# (from the same directory as jimsh). +# If we don't have that, just skip these tests. + +set buildjimext [file join [file dirname [info nameofexecutable]] build-jim-ext] +# loadtest.c is in the same directory as this script +set src [file join [file dirname [info script]] loadtest.c] + +set skip 1 +if {[file exec $buildjimext]} { + set skip [catch { + exec $buildjimext $src + }] + if {!$skip && ![file exists loadtest.so]} { + set skip 1 + } +} +if {$skip} { + skiptest " (no working build-jim-ext)" +} + +test load-1.0 {load usage} -body { + load +} -returnCodes error -result {wrong # args: should be "load libraryFile"} + +# Now everything is done in a child interpreter so that +# because loadable modules only get unloaded on interpreter exit +test load-1.1 {load initial} { + set interp [interp] + $interp eval {exists -command loadtest} +} {0} + +test load-1.2 {create loadable extension} -body { + exec $buildjimext $src + file exists loadtest.so +} -result {1} + +test load-1.3 {load dynamic extension} -body { + $interp eval { + load loadtest.so + exists -command loadtest + } +} -result {1} + +test load-1.4 {run dynamic extension command} -body { + $interp eval { + loadtest test abc + } +} -result {abc} + +test load-1.5 {load invalid dynamic extension} -body { + $interp eval { + load nonexistent + } +} -returnCodes error -match glob -result {error loading extension "nonexistent": *} + +$interp delete + +test load-1.6 {load via package require} { + set interp [interp] + $interp eval { + lappend auto_path [pwd] + package require loadtest + exists -command loadtest + } +} {1} + +$interp delete + +test load-2.1 {loadable extension with full path} -body { + set interp [interp] + exec $buildjimext $src + $interp eval { + load [pwd]/loadtest.so + loadtest test def + } +} -result {def} -cleanup { + $interp delete +} + +test load-2.2 {loadable extension without extension} -body { + set interp [interp] + file rename loadtest.so loadtest + $interp eval { + load loadtest + loadtest test def + } +} -result {def} -cleanup { + $interp delete + file delete loadtest +} + +test load-2.1 {loadable extension with no entrypoint} -body { + set interp [interp] + exec $buildjimext --notest -DNO_ENTRYPOINT $src + $interp eval { + load loadtest.so + } +} -returnCodes error -result {No Jim_loadtestInit symbol found in extension loadtest.so} -cleanup { + $interp delete +} + +file delete loadtest.so + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/loadtest.c jimtcl-0.81+dfsg0/tests/loadtest.c --- jimtcl-0.79+dfsg0/tests/loadtest.c 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/loadtest.c 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,36 @@ +#include +#include + +static int loadtest_cmd_test(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_SetResult(interp, argv[0]); + return JIM_OK; +} + +static const jim_subcmd_type loadtest_command_table[] = { + { "test", + "arg", + loadtest_cmd_test, + 1, + 1, + }, + { NULL } +}; + +static int loadtest_cmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return Jim_CallSubCmd(interp, Jim_ParseSubCmd(interp, loadtest_command_table, argc, argv), argc, argv); +} + +#ifndef NO_ENTRYPOINT +int Jim_loadtestInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "loadtest", "1.0", JIM_ERRMSG)) { + return JIM_ERR; + } + + Jim_CreateCommand(interp, "loadtest", loadtest_cmd, 0, 0); + + return JIM_OK; +} +#endif diff -Nru jimtcl-0.79+dfsg0/tests/loop.test jimtcl-0.81+dfsg0/tests/loop.test --- jimtcl-0.79+dfsg0/tests/loop.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/loop.test 2021-11-27 23:06:54.000000000 +0000 @@ -75,6 +75,14 @@ set a } {} +test loop-1.11 {no start} { + set a {} + loop i 5 { + lappend a $i + } + set a +} {0 1 2 3 4} + test loop-2.1 {loop shimmering tests} { loop i 1 6 { } diff -Nru jimtcl-0.79+dfsg0/tests/lrange.test jimtcl-0.81+dfsg0/tests/lrange.test --- jimtcl-0.79+dfsg0/tests/lrange.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/lrange.test 2021-11-27 23:06:54.000000000 +0000 @@ -69,10 +69,10 @@ } {1 {wrong # args: should be "lrange list first last"}} test lrange-2.3 {error conditions} { list [catch {lrange a b 6} msg] $msg -} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "b": must be intexpr or end?[+-]intexpr?}} test lrange-2.4 {error conditions} { list [catch {lrange a 0 enigma} msg] $msg -} {1 {bad index "enigma": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "enigma": must be intexpr or end?[+-]intexpr?}} test lrange-2.5 {error conditions} tcl { list [catch {lrange "a \{b c" 3 4} msg] $msg } {1 {unmatched open brace in list}} diff -Nru jimtcl-0.79+dfsg0/tests/lreplace.test jimtcl-0.81+dfsg0/tests/lreplace.test --- jimtcl-0.79+dfsg0/tests/lreplace.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/lreplace.test 2021-11-27 23:06:54.000000000 +0000 @@ -116,13 +116,13 @@ } {1 {wrong # args: should be "lreplace list first last ?element ...?"}} test lreplace-2.3 {lreplace errors} { list [catch {lreplace x a 10} msg] $msg -} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "a": must be intexpr or end?[+-]intexpr?}} test lreplace-2.4 {lreplace errors} { list [catch {lreplace x 10 x} msg] $msg -} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "x": must be intexpr or end?[+-]intexpr?}} test lreplace-2.5 {lreplace errors} { list [catch {lreplace x 10 1x} msg] $msg -} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "1x": must be intexpr or end?[+-]intexpr?}} test lreplace-2.6 {lreplace errors} { list [catch {lreplace x 3 2} msg] $msg } {0 x} diff -Nru jimtcl-0.79+dfsg0/tests/lsearch.test jimtcl-0.81+dfsg0/tests/lsearch.test --- jimtcl-0.79+dfsg0/tests/lsearch.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/lsearch.test 2021-11-27 23:06:54.000000000 +0000 @@ -72,6 +72,14 @@ lsearch -nocase -glob {b.x ^bc xy bcx} B* } 0 +test lsearch-2.10 {regexp with option-looking pattern} regexp { + lsearch -regexp {-abc -def -ghi} -def +} 1 + +test lsearch-2.11 {regexp with option-looking pattern, -nocase} regexp { + lsearch -nocase -regexp {-abc -def -ghi} -DEF +} 1 + test lsearch-3.1 {lsearch errors} { list [catch lsearch msg] } {1} @@ -179,4 +187,117 @@ lsearch -not -bool -glob -all -nocase {a1 a2 b1 b2 a3 b3} B* } {1 1 0 0 1 0} +test lsearch-17.1 {lsearch -index option, basic functionality} { + lsearch -index 1 {{a c} {a b} {a a}} a +} 2 +test lsearch-17.2 {lsearch -index option, basic functionality} { + lsearch -index 1 -exact {{a c} {a b} {a a}} a +} 2 +test lsearch-17.3 {lsearch -index option, basic functionality} { + lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b* +} 1 +test lsearch-17.4 {lsearch -index option, basic functionality} { + lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b} +} 0 +test lsearch-17.5 {lsearch -index option, basic functionality} { + lsearch -all -index 0 -exact {{a c} {a b} {d a}} a +} {0 1} +test lsearch-17.6 {lsearch -index option, basic functionality} { + lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b* +} {1 2} +test lsearch-17.7 {lsearch -index option, basic functionality} { + lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b} +} {0 1} +test lsearch-17.8 {lsearch -index option, empty argument} { + lsearch -index {} a a +} 0 +test lsearch-17.9 {lsearch -index option, empty argument} { + lsearch -index {} a a +} [lsearch a a] +test lsearch-17.10 {lsearch -index option, empty argument} { + lsearch -index {} [list \{] \{ +} 0 +test lsearch-17.11 {lsearch -index option, empty argument} { + lsearch -index {} [list \{] \{ +} [lsearch [list \{] \{] +test lsearch-17.12 {lsearch -index option, encoding aliasing} -body { + lsearch -index -2 a a +} -returnCodes error -result {index "-2" out of range} +test lsearch-17.13 {lsearch -index option, encoding aliasing} -body { + lsearch -index -1-1 a a +} -returnCodes error -result {index "-1-1" out of range} +test lsearch-17.14 {lsearch -index option, encoding aliasing} -body { + lsearch -index end--1 a a +} -returnCodes error -result {index "end--1" out of range} +test lsearch-17.15 {lsearch -index option, encoding aliasing} -body { + lsearch -index end+1 a a +} -returnCodes error -result {index "end+1" out of range} +test lsearch-17.16 {lsearch -index option, encoding aliasing} -body { + lsearch -index end+2 a a +} -returnCodes error -result {index "end+2" out of range} + +test lsearch-20.1 {lsearch -index option, index larger than sublists} -body { + lsearch -index 2 {{a c} {a b} {a a}} a +} -returnCodes error -result {element 2 missing from sublist "a c"} +test lsearch-20.2 {lsearch -index option, malformed index} -body { + lsearch -index foo {{a c} {a b} {a a}} a +} -returnCodes error -match glob -result {bad index *} + +test lsearch-23.1 {lsearch -stride option, errors} -body { + lsearch -stride {a b} a +} -returnCodes error -match glob -result {*} +test lsearch-23.2 {lsearch -stride option, errors} -body { + lsearch -stride 0 {a b} a +} -returnCodes error -result {stride length must be at least 1} +test lsearch-23.3 {lsearch -stride option, errors} -body { + lsearch -stride 2 {a b c} a +} -returnCodes error -result {list size must be a multiple of the stride length} +test lsearch-23.4 {lsearch -stride option, errors} -body { + lsearch -stride 5 {a b c} a +} -returnCodes error -result {list size must be a multiple of the stride length} +test lsearch-23.5 {lsearch -stride option, errors} -body { + # Stride equal to length is ok + lsearch -stride 3 {a b c} a +} -result 0 + +test lsearch-24.1 {lsearch -stride option} -body { + lsearch -stride 2 {a b c d e f g h} d +} -result -1 +test lsearch-24.2 {lsearch -stride option} -body { + lsearch -stride 2 {a b c d e f g h} e +} -result 4 +test lsearch-24.3 {lsearch -stride option} -body { + lsearch -stride 3 {a b c d e f g h i} e +} -result -1 +test lsearch-24.4 {lsearch -stride option} -body { + # Result points first in group + lsearch -stride 3 -index 1 {a b c d e f g h i} e +} -result 3 +test lsearch-24.5 {lsearch -stride option} -body { + lsearch -inline -stride 2 {a b c d e f g h} d +} -result {} +test lsearch-24.6 {lsearch -stride option} -body { + # Inline result is a "single element" strided list + lsearch -inline -stride 2 {a b c d e f g h} e +} -result "e f" +test lsearch-24.7 {lsearch -stride option} -body { + lsearch -inline -stride 3 {a b c d e f g h i} e +} -result {} +test lsearch-24.8 {lsearch -stride option} -body { + lsearch -inline -stride 3 -index 1 {a b c d e f g h i} e +} -result "d e f" +test lsearch-24.9 {lsearch -stride option} -body { + lsearch -all -inline -stride 3 -index 1 {a b c d e f g e i} e +} -result "d e f g e i" +test lsearch-24.10 {lsearch -stride option} -body { + lsearch -all -inline -stride 3 -index 0 {a b c d e f a e i} a +} -result "a b c a e i" +test lsearch-24.11 {lsearch -stride option} -body { + # Stride 1 is same as no stride + lsearch -stride 1 {a b c d e f g h} d +} -result 3 +test lsearch-24.12 {lsearch -stride -index with missing elements} -body { + lsearch -stride 1 -index {1 1} {a b c} c +} -returnCodes error -result {element 1 missing from sublist "a"} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/lsort.test jimtcl-0.81+dfsg0/tests/lsort.test --- jimtcl-0.79+dfsg0/tests/lsort.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/lsort.test 2021-11-27 23:06:54.000000000 +0000 @@ -17,7 +17,7 @@ } {1 {wrong # args: should be "lsort ?options? list"}} test lsort-1.2 {Tcl_LsortObjCmd procedure} jim { list [catch {lsort -foo {1 3 2 5}} msg] $msg -} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, -nocase, -real, or -unique}} +} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, -nocase, -real, -stride, or -unique}} test lsort-1.3 {Tcl_LsortObjCmd procedure, default options} { lsort {d e c b a \{ d35 d300} } {a b c d d300 d35 e \{} @@ -51,7 +51,7 @@ } {1 {"-index" option must be followed by list index}} test lsort-1.12 {Tcl_LsortObjCmd procedure, -index option} { list [catch {lsort -index foo {1 3 2 5}} msg] $msg -} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "foo": must be intexpr or end?[+-]intexpr?}} test lsort-1.13 {Tcl_LsortObjCmd procedure, -index option} { lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1} } {1 {2 25} {3 16 42} {10 20 50 100}} @@ -131,12 +131,12 @@ test lsort-3.2 {lsort -real, returning indices} { lsort -decreasing -real {1.2 34.5 34.5 5.6} } {34.5 34.5 5.6 1.2} -test lsort-3.3 {SortCompare procedure, -index option} jim { - list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg -} {1 {list index out of range}} -test lsort-3.5 {SortCompare procedure, -index option} jim { - list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg -} {1 {list index out of range}} +test lsort-3.3 {SortCompare procedure, -index option} -body { + lsort -integer -index 2 {{20 10} {15 30 40}} +} -returnCodes error -result {element 2 missing from sublist "20 10"} +test lsort-3.5 {SortCompare procedure, -index option} -body { + lsort -integer -index 2 {{20 10 13} {15}} +} -returnCodes error -result {index "2" out of range} test lsort-3.6 {SortCompare procedure, -index option} { lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}} } {{3 25 20} {2 5 25} {1 15 30}} @@ -202,12 +202,40 @@ set vallist } {0 4 5} -test lsort-4.26 {DefaultCompare procedure, signed characters} utf8 { - lsort [list "abc\u80" "abc"] -} [list "abc" "abc\u80"] test lsort-5.1 "Sort case insensitive" { lsort -nocase {ba aB aa ce} } {aa aB ba ce} +test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} { + lsort -stride 2 {f e d c b a} +} {b a d c f e} +test cmdIL-1.31 {Tcl_LsortObjCmd procedure, -stride option} { + lsort -stride 3 {f e d c b a} +} {c b a f e d} +test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body { + lsort -stride foo bar +} -result {expected integer but got "foo"} +test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body { + lsort -stride 1 bar +} -result {stride length must be at least 2} +test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body { + lsort -stride 2 {a b c} +} -result {list size must be a multiple of the stride length} +test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body { + lsort -stride 2 -index 3 {a b c d} +} -match glob -result {*} +test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} { + lsort -stride 2 -index {0 1} { + {{c o d e} 54321} {{b l a h} 94729} + {{b i g} 12345} {{d e m o} 34512} + } +} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}} +test cmdIL-1.41 {lsort -stride and -index} -body { + lsort -stride 2 -index -2 {a 2 b 1} +} -returnCodes error -result {index "-2" out of range} +test cmdIL-1.42 {lsort -stride and-index} -body { + lsort -stride 2 -index -1-1 {a 2 b 1} +} -returnCodes error -result {index "-1-1" out of range} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/Makefile.in jimtcl-0.81+dfsg0/tests/Makefile.in --- jimtcl-0.79+dfsg0/tests/Makefile.in 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/Makefile.in 2021-11-27 23:06:54.000000000 +0000 @@ -1,13 +1,11 @@ jimsh ?= ../jimsh tclsh ?= tclsh -DEF_LD_PATH := @LD_LIBRARY_PATH@="@builddir@:$(@LD_LIBRARY_PATH@)" - test: - @$(DEF_LD_PATH) $(jimsh) runall.tcl + @LD_LIBRARY_PATH="@builddir@:$(@LD_LIBRARY_PATH@)" "$(jimsh)" "@abs_top_srcdir@/tests/runall.tcl" tcl: - @rc=0; for i in *.test; do $(tclsh) -encoding utf-8 $$i || rc=$?; done; exit $$rc + @rc=0; for i in "@abs_top_srcdir@"/tests/*.test; do "$(tclsh)" -encoding utf-8 $$i || rc=$?; done; exit $$rc clean: rm -f gorp.file2 gorp.file sleepx test1 exec.tmp1 diff -Nru jimtcl-0.79+dfsg0/tests/misc.test jimtcl-0.81+dfsg0/tests/misc.test --- jimtcl-0.79+dfsg0/tests/misc.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/misc.test 2021-11-27 23:06:54.000000000 +0000 @@ -288,8 +288,8 @@ test catch-1.7 "catch exit" { # Normally exit would not be caught - dict get [info returncodes] [catch -exit {exit 5} result] -} {exit} + list [dict get [info returncodes] [catch -exit {exit 5} result]] $result +} {exit 5} test catch-1.8 "catch error has -errorinfo" { set rc [catch {set undefined} msg opts] @@ -306,7 +306,7 @@ proc b {} { catch {a} msg opts; return {*}$opts $msg } set rc [catch {b} msg opts] list $rc $msg [llength $opts(-errorinfo)] -} {1 {from a} 6} +} {1 {from a} 9} test return-1.2 "error can rethrow an error" { proc a {} { error "from a" } @@ -527,20 +527,25 @@ list $a(3) $a } {4 {3 4}} -test jim-badvar-1.1 "invalid variable name" { +test jim-badvar-1.1 "variable name with embedded null" { set x b\0c - catch {set $x 5} -} 1 + set $x 5 +} 5 -test jim-badvar-1.2 "incr invalid variable name" { +test jim-badvar-1.2 "incr variable name with embedded null" { set x b\0c - catch {incr $x} -} 1 + incr $x +} 6 test lset-1.1 "lset with bad var" { catch {lset badvar 1 x} } 1 +test lset-1.2 "lset error message" { + catch lset msg + set msg +} {wrong # args: should be "lset listVar ?index ...? value"} + test dict-1.1 "dict to string" { set a [dict create abc \\ def \"] set x x$a diff -Nru jimtcl-0.79+dfsg0/tests/namespace.test jimtcl-0.81+dfsg0/tests/namespace.test --- jimtcl-0.79+dfsg0/tests/namespace.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/namespace.test 2021-11-27 23:06:54.000000000 +0000 @@ -139,6 +139,24 @@ } } -returnCodes error -result {can't define "x(3)": name refers to an element in an array} + +test namespace-1.29 {namespace variable too many args} -body { + namespace eval ns1 { + variable x(3) y a b c + } +} -returnCodes error -result {wrong # args: should be "variable name ?value?"} + +test namespace-1.30 {namespace current too many args} -body { + namespace current a +} -returnCodes error -result {wrong # args: should be "namespace current"} + +# TODO: Add tests for canonical option + +test namespace-1.31 {namespace canonical too many args} -body { + namespace canonical a b c +} -returnCodes error -result {wrong # args: should be "namespace canonical ?current? ?name?"} + + unset -nocomplain ns1::x ns1::y # ----------------------------------------------------------------------- @@ -287,6 +305,13 @@ [namespace parent nsh1::nsh2::nsh3a] } {{} :: ::nsh1 ::nsh1::nsh2} +test namespace-5.22 {query namespace parent with fully qualified names} { + list [namespace eval :: {namespace parent}] \ + [namespace eval ::nsh1 {namespace parent}] \ + [namespace eval ::nsh1::nsh2 {namespace parent}] \ + [namespace eval nsh1::nsh2::nsh3a {namespace parent ::nsh1::nsh2}] \ +} {{} :: ::nsh1 ::nsh1} + # ----------------------------------------------------------------------- # TEST: name resolution and caching # ----------------------------------------------------------------------- @@ -506,6 +531,13 @@ namespace delete one two three } -returnCodes error -match glob -result {import pattern * would create a loop*} +test namespace-12.4 {namespace import} { + namespace eval ::test_ns_one {} + proc ::test_ns_one::testcmd args { return 2 } + namespace import ::test_ns_one::* + testcmd +} 2 + foreach cmd [info commands test_ns_*] { rename $cmd "" } diff -Nru jimtcl-0.79+dfsg0/tests/package.test jimtcl-0.81+dfsg0/tests/package.test --- jimtcl-0.79+dfsg0/tests/package.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/package.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,24 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +needs cmd package + +if {[exists -proc package]} { + skiptest " (bootstrap jimsh)" +} + +test package-1.1 {provide} -body { + package provide new-package-name + expr {"new-package-name" in [package names]} +} -result 1 + +test package-1.2 {provide, duplicate} -body { + package provide new-package-name +} -returnCodes error -result {package "new-package-name" was already provided} + +test package-1.3 {package names} -body { + expr {"stdlib" in [package names]} +} -result 1 + +testreport + diff -Nru jimtcl-0.79+dfsg0/tests/pack.test jimtcl-0.81+dfsg0/tests/pack.test --- jimtcl-0.79+dfsg0/tests/pack.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/pack.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,116 @@ +source [file dirname [info script]]/testing.tcl + +needs cmd pack + +test pack-1.1 {pack usage} -body { + pack +} -returnCodes error -result {wrong # args: should be "pack varName value -intle|-intbe|-floatle|-floatbe|-str bitwidth ?bitoffset?"} + +test pack-1.2 {pack invalid type} -body { + pack a 1 -badopt 8 +} -returnCodes error -result {bad option "-badopt": must be -floatbe, -floatle, -intbe, -intle, or -str} + +test pack-1.3 {pack bad width} -body { + pack a 1 -intbe badint +} -returnCodes error -match glob -result {expected integer *but got "badint"} + +test pack-1.4 {pack bad width} -body { + pack a 1 -intbe -5 +} -returnCodes error -result {bad bitwidth: -5} + +test pack-1.5 {pack bad offset} -body { + pack a 1 -intbe 5 badint +} -returnCodes error -match glob -result {expected integer *but got "badint"} + +test pack-1.6 {pack bad offset} -body { + pack a 1 -intbe 5 -6 +} -returnCodes error -result {bad bitoffset: -6} + +test pack-2.1 {pack basic} { + unset -nocomplain a + pack a 65 -intle 8 + set a +} {A} + +test pack-2.2 {pack append} { + pack a 66 -intle 8 8 + set a +} {AB} + +test pack-2.3 {pack after end pads with null} { + pack a 67 -intle 8 24 + set a +} "AB\x00C" + +test pack-2.4 {pack replace} { + pack a 68 -intle 8 16 + set a +} "ABDC" + +test pack-2.5 {pack str after end pads with null} { + pack a ghi -str 24 40 + set a +} "ABDC\x00ghi" + +test pack-2.6 {pack str width > string length} { + set a {} + pack a ab -str 32 + set a +} "ab\x00\x00" + +set badvar {a} + +test pack-2.7 {pack bad set} -body { + pack badvar(a) 32 -intle 8 +} -returnCodes error -result {can't set "badvar(a)": variable isn't array} + +test pack-2.8 {pack bad set} -body { + pack bad\x00var 32 -intle 8 +} -returnCodes ok -result {8} + +test unpack-1.1 {unpack usage} -body { + unpack +} -returnCodes error -result {wrong # args: should be "unpack binvalue -intbe|-intle|-uintbe|-uintle|-floatbe|-floatle|-str bitpos bitwidth"} + +test unpack-1.2 {unpack invalid type} -body { + unpack abc -badopt 0 8 +} -returnCodes error -result {bad option "-badopt": must be -floatbe, -floatle, -intbe, -intle, -str, -uintbe, or -uintle} + +test unpack-1.3 {unpack bad width} -body { + unpack abc -intle 0 badint +} -returnCodes error -match glob -result {expected integer *but got "badint"} + +test unpack-1.4 {unpack bad width} -body { + unpack abc -intle 0 -5 +} -returnCodes error -result {bad bitwidth: -5} + +test unpack-1.5 {unpack bad offset} -body { + unpack abc -intle badint 8 +} -returnCodes error -match glob -result {expected integer *but got "badint"} + +test unpack-1.6 {unpack bad offset} -body { + unpack abc -intle -6 8 +} -returnCodes error -result {bad bitoffset: -6} + +test unpack-1.7 {unpack str not on byte boundary offset} -body { + unpack abc -str 5 8 +} -returnCodes error -result {bad bitoffset: 5} + +test unpack-1.8 {unpack float bad width} -body { + unpack abc -floatbe 0 24 +} -returnCodes error -result {bad bitwidth: 24} + +test unpack-2.1 {unpack str width past end} -body { + unpack abc -str 16 16 +} -result c + +test unpack-2.2 {unpack intle} -body { + format 0x%04x [unpack \x01\x02\x03 -intle 8 16] +} -result 0x0302 + +test unpack-2.3 {unpack int width past end} -body { + unpack \x01\x02\x03 -intle 16 16 +} -result 3 + + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/parse.test jimtcl-0.81+dfsg0/tests/parse.test --- jimtcl-0.79+dfsg0/tests/parse.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/parse.test 2021-11-27 23:06:54.000000000 +0000 @@ -334,5 +334,42 @@ incr x } 2 +test parse-1.66 {backslash newline} { + proc "abc def" {x} { incr x; return $x } + set x ["abc\ + def" 4] +} {5} + +test parse-1.67 {missing quote in command} -body { + set x ["abc\ + def] +} -returnCodes error -match regexp -result {missing ("|quote)} + +test parse-1.68 {missing quote} -body { + set x "abc\ + line without quote + +} -returnCodes error -match regexp -result {missing ("|quote)} + +test parse-1.69 {comment with trailing backslash} { + set x "#abc \\" + eval $x +} {} + +test parse-1.70 {info complete, missing quotes} { + set v 1 + set result {} + # missing leading quote is ok + foreach p { + {"abc} + {"abc$v} + {abc"} + {abc$v"} + {"abc$v"} + } { + lappend result [info complete $p] + } + set result +} {0 0 1 1 1} testreport diff -Nru jimtcl-0.79+dfsg0/tests/posix.test jimtcl-0.81+dfsg0/tests/posix.test --- jimtcl-0.79+dfsg0/tests/posix.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/posix.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,37 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +testCmdConstraints os.getids os.gethostname os.uptime os.fork + +test posix-1.1 {os.getids usage} -constraints os.getids -body { + os.getids blah +} -returnCodes error -result {wrong # args: should be "os.getids"} + +test posix-1.2 {os.getids} -constraints os.getids -body { + set uid [exec id -u] + set d [os.getids] + if {$d(uid) != $uid} { + error "os.getids uid=$d(uid) not match system $uid" + } +} -result {} + + +test posix-1.4 {os.uptime} -constraints os.uptime -body { + string is integer -strict [os.uptime] +} -result {1} + +test posix-1.5 {os.gethostname usage} -constraints os.gethostname -body { + os.gethostname blah +} -returnCodes error -result {wrong # args: should be "os.gethostname"} + +test posix-1.6 {os.gethostname} -constraints os.gethostname -body { + if {[exec hostname] ne [os.gethostname]} { + error "os.gethostname did not match system hostname" + } +} -result {} + +test posix-1.7 {os.fork usage} -constraints os.fork -body { + os.fork extra args +} -returnCodes error -result {wrong # args: should be "os.fork"} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/proc-new.test jimtcl-0.81+dfsg0/tests/proc-new.test --- jimtcl-0.79+dfsg0/tests/proc-new.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/proc-new.test 2021-11-27 23:06:54.000000000 +0000 @@ -124,4 +124,13 @@ catch {a B} } 1 +test proc-3.5 "error message with optional args" { + proc a {b args} { + return $args + } + catch a msg + set msg +} {wrong # args: should be "a b ?arg ...?"} + + testreport diff -Nru jimtcl-0.79+dfsg0/tests/proc.test jimtcl-0.81+dfsg0/tests/proc.test --- jimtcl-0.79+dfsg0/tests/proc.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/proc.test 2021-11-27 23:06:54.000000000 +0000 @@ -246,7 +246,9 @@ list [catch {proc tproc b c d e} msg] } {1} - +test proc-5.4 {proc double args} -body { + proc a {args args} {} +} -returnCodes error -result {'args' specified more than once} test proc-old-5.6 {error conditions} { list [catch {proc tproc {{} y} {return foo}} msg] $msg diff -Nru jimtcl-0.79+dfsg0/tests/ref.test jimtcl-0.81+dfsg0/tests/ref.test --- jimtcl-0.79+dfsg0/tests/ref.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/ref.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,24 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +needs cmd ref +needs cmd collect + +test collect-1.1 {ensure globally scoped references are deleted} { + collect + set result {} + + # Create a globally scoped reference as a function name + set a ::[ref testfunction -] + proc $a {} { return 3 } + lappend result [$a] + # It shouldn't be collected + lappend result [collect] + lappend result [$a] + unset a + # Now it should be collected + lappend result [collect] + set result +} {3 0 3 1} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/regcount.test jimtcl-0.81+dfsg0/tests/regcount.test --- jimtcl-0.79+dfsg0/tests/regcount.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/regcount.test 2021-11-27 23:06:54.000000000 +0000 @@ -44,8 +44,9 @@ a{1,2}? baaaad a a{3,4}? baaaad aaa a{5,6}? baaaad {} + (a|b){3,4}?def baaaad {} {\d{1,3}} 239 239 - (aa|bb)?c xabbaac {aac aa} + (aa|bb)?cdef xcdabbaacdef {aacdef aa} (a|y)+ bac {a a} (a|y){1,} bac {a a} (a|y)* bac {{} {}} @@ -84,6 +85,13 @@ (a|y){5,6}? baaaad {} {[[:alpha:]]+} _bcd56_ef bcd {[[:alnum:]]+} _bcd56_ef bcd56 + {[[:blank:]]+} "_b \t\n6cAF" "{ \t}" + {[[:upper:]]+} "_b \t\n6cAF" {AF} + {[[:lower:]]+} "_b \t\n6cAF" {b} + {[[:cntrl:]]+} _bcd\x04z56_ef "\x04" + {[[:print:]]+} "\v _b \t\n6cAF" {{ _b }} + {[[:graph:]]+} " _,b \t\n6cAF" {_,b} + {[[:punct:]]+} bcd56_,ef _, {[\w]+} :_bcd56_ef _bcd56_ef {[[:space:]]+} "_bc \t\r\n\f\v_" "{ \t\r\n\f\v}" {[\x41-\x43]+} "_ABCD_" ABC @@ -96,6 +104,8 @@ ####((a*)*b)*b aaaaaaaaaaaaaaaaaaaaaaaaab {b {} {}} ####(a*)* aab {aa {}} {^([^:=]*)(:)?(=)?$} version {version version {} {}} + {\Aab.} abc,abd abc + {de.\Z} def,deh,dei dei } { if {[string match #* $pat]} { continue diff -Nru jimtcl-0.79+dfsg0/tests/regexp2.test jimtcl-0.81+dfsg0/tests/regexp2.test --- jimtcl-0.79+dfsg0/tests/regexp2.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/regexp2.test 2021-11-27 23:06:54.000000000 +0000 @@ -287,7 +287,7 @@ evalInProc { list [catch {regexp -start bogus {^$} {}} msg] $msg } -} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}} test regexpComp-7.1 {basic regsub operation} { evalInProc { @@ -494,6 +494,15 @@ # list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo # } #} "1 {da\nb123\nxb}" +test regexpComp-10.6 {\Z only matching end of string with -line} { + evalInProc { + set foo xxx + list [regsub -line {^a.*b\Z} "dabc\ncaxyb\naxb" 123 foo] $foo + } +} "1 {dabc\ncaxyb\n123}" +test regexpComp-10.7 {\A only matching beginning of string with -line} { + regexp -all -inline -line {\Aab.} abc\nabd +} {abc} test regexpComp-11.1 {regsub errors} { evalInProc { @@ -536,7 +545,7 @@ evalInProc { list [catch {regsub -start bogus pattern string rep var} msg] $msg } -} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}} # This test crashes on the Mac unless you increase the Stack Space to about 1 # Meg. This is probably bigger than most users want... @@ -622,11 +631,11 @@ catch {unset x} list [regsub -all -start 3 {z} hello {/&} x] $x } {0 hello} -#test regexpComp-16.4 {regsub -start, \A behavior} { -# set out {} -# lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x -# lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x -#} {5 /a/b/c/d/e 3 ab/c/d/e} +test regexpComp-16.4 {regsub -start, \A behavior} tcl { + set out {} + lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x + lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x +} {5 /a/b/c/d/e 3 ab/c/d/e} test regexpComp-16.5 {regexp -start with utf8} utf8 { regexp -inline -start 1 . \u0442\u0435\u0441\u0442 } \u0435 @@ -634,6 +643,14 @@ regsub -start 1 . \u0442\u0435\u0441\u0442 x } \u0442x\u0441\u0442 +test regexpComp-16.7 {regexp -start with \A} { + regsub -start 1 {\Aabc} deabc - +} {deabc} + +test regexpComp-16.7 {regexp -start with \A} { + regsub -start 1 {\Aabc} dabc - +} {d-} + test regexpComp-17.1 {regexp -inline} { regexp -inline b ababa } {b} diff -Nru jimtcl-0.79+dfsg0/tests/regexp.test jimtcl-0.81+dfsg0/tests/regexp.test --- jimtcl-0.79+dfsg0/tests/regexp.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/regexp.test 2021-11-27 23:06:54.000000000 +0000 @@ -221,7 +221,7 @@ } {1 {can't set "f1(f2)": variable isn't array}} test regexp-6.9 {regexp errors, -start bad int check} { list [catch {regexp -start bogus {^$} {}} msg] $msg -} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}} test regexp-6.10 {regexp errors, -start too few args} { list [catch {regexp -all -start} msg] $msg } {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}} @@ -378,7 +378,7 @@ } {1 {can't set "f1(f2)": variable isn't array}} test regexp-11.8 {regsub errors, -start bad int check} { list [catch {regsub -start bogus pattern string rep var} msg] $msg -} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}} test regexp-11.9 {regsub without final variable name returns value} { regsub b abaca X } {aXaca} @@ -489,11 +489,11 @@ catch {unset x} list [regsub -all -start 3 {z} hello {/&} x] $x } {0 hello} -#test regexp-16.4 {regsub -start, \A behavior} { -# set out {} -# lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x -# lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x -#} {5 /a/b/c/d/e 3 ab/c/d/e} +test regexp-16.4 {regsub -start, \A behavior} { + set out {} + lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x + lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x +} {5 /a/b/c/d/e 3 ab/c/d/e} test regexp-16.5 {regsub -start, double option} { list [regsub -start 2 -start 0 a abc c x] $x } {1 cbc} @@ -661,6 +661,87 @@ set value } "\\abc\\def" +test regexp-22.1 {char range} { + regexp -all -inline {[a-c]+} "defaaghbcadfbaacccd" +} {aa bca baaccc} + +# Tcl doesn't like this +test regexp-22.2 {reversed char range} jim { + regexp -all -inline {[c-a]+} "defaaghbcadfbaacccd" +} {aa bca baaccc} + +# Note that here the hex escapes are interpreted by regexp, not by Tcl +test regexp-22.3 {hex digits} { + regexp -all -inline {[\x6a-\x6c]+} "jlaksdjflkwueorilkj" +} {jl k j lk lkj} + +test regexp-22.4 {uppercase hex digits} { + regexp -all -inline {[\x6A-\x6C]+} "jlaksdjflkwueorilkj" +} {jl k j lk lkj} + +# Below \x9X will be treated as \x9 followed by X +test regexp-22.5 {invalid hex digits} { + regexp -all -inline {[\x9X\x6C]+} "jla\tX6djflyw\tueorilkj" +} [list l \tX l \t l] + +test regexp-22.6 {unicode hex digits} jim { + regexp -all -inline {[\u{41}-\u{00043}]+} "AVBASDFBABDFBAFBAFA" +} {A BA BAB BA BA A} + +# \u{X41} is treated as u { X 41 } +test regexp-22.7 {unicode hex digits with invalid exscape} jim { + regexp -all -inline {[\u{X41}]+} "uVBAX{SD4B1}DFBAFBAFA" +} {u X\{ 4 1\}} + +test regexp-22.8 {unicode hex digits} { + regexp -all -inline {[\u0041-\u0043]+} "AVBASDFBABDFBAFBAFA" +} {A BA BAB BA BA A} + +test regexp-22.9 {\U unicode hex digits} { + regexp -all -inline {[\U00000041-\U00000043]+} "AVBASDFBABDFBAFBAFA" +} {A BA BAB BA BA A} + +test regexp-22.10 {Various char escapes} { + set result {} + foreach match [regexp -all -inline {[\e\f\v\t\b]+} "A\f\vBB\b\tC\x1BG"] { + set chars {} + foreach c [split $match ""] { + scan $c %c char + lappend chars $char + } + lappend result [join $chars ,] + } + join $result | +} {12,11|8,9|27} + +test regexp-22.11 {backslash as last char} -body { + regexp -all -inline "\[a\\" "ba\\d\[ef" +} -returnCodes error -result {couldn't compile regular expression pattern: invalid escape \ sequence} + +test regexp-22.12 {missing closing bracket} -body { + regexp -all -inline {[abc} "abcdefghi" +} -returnCodes error -result {couldn't compile regular expression pattern: brackets [] not balanced} + +test regexp-22.13 {empty alternative} { + regexp -all -inline {a(a|b|)c} "aacbacbaa" +} {aac a ac {}} + +test regexp-22.14 {] in set} { + regexp -all -inline {[]ab]+} "aac\[ba\]cbaa" +} {aa ba\] baa} + +test regexp-22.15 {- in set} { + regexp -all -inline {[-ab]+} "aac\[ba\]cb-aa" +} {aa ba b-aa} + +test regexp-22.16 {\s in set} { + regexp -all -inline {[\sa]+} "aac\[b a\]c\tb-aa" +} [list aa " a" \t aa] + +test regexp-22.17 {\d in set} { + regexp -all -inline {[a\d]+} "a0ac\[b a\]44c\tb-1aa7" +} {a0a a 44 1aa7} + # Tests resulting from bugs reported by users test reg-31.1 {[[:xdigit:]] behaves correctly when followed by [[:space:]]} { set str {2:::DebugWin32} @@ -669,4 +750,8 @@ # Code used to produce {1 2:::DebugWin32 2 :::DebugWin32} !!! } {1 2 2 {}} +test reg-31.2 {scanner not reset in failed optional group} { + regexp -inline {^(?:(-)(?:(\w[\w-]*)\|)?)?(\w[\w-]*)$} -debug +} {-debug - {} debug} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/return.test jimtcl-0.81+dfsg0/tests/return.test --- jimtcl-0.79+dfsg0/tests/return.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/return.test 2021-11-27 23:06:54.000000000 +0000 @@ -1,5 +1,7 @@ source [file dirname [info script]]/testing.tcl +set testpath [file dirname [info script]] + # return -code test return-1.1 {return -code} { @@ -8,11 +10,11 @@ } {2 result} test return-1.2 {source file with break} { - list [catch {source break.tcl} msg] $msg + list [catch {source $testpath/break.tcl} msg] $msg } {3 {}} test return-1.3 {source file with break} { - list [catch {source return-break.tcl} msg] $msg + list [catch {source $testpath/return-break.tcl} msg] $msg } {3 result} proc a {level code msg} { @@ -47,4 +49,9 @@ list [catch {b 2 20 text} msg] $msg } {20 text} +test return-2.7 {return -level 0 -code break} { + list [catch {return -level 0 -code break text} msg] $msg +} {3 text} + + testreport diff -Nru jimtcl-0.79+dfsg0/tests/runall.tcl jimtcl-0.81+dfsg0/tests/runall.tcl --- jimtcl-0.79+dfsg0/tests/runall.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/runall.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -5,26 +5,28 @@ lappend auto_path . +set testdir [file dirname [info script]] + # In case interp is a module catch {package require interp} if {[info commands interp] eq ""} { - set rc 1 - foreach script [lsort [glob *.test]] { + set rc 0 + foreach script [lsort [glob $testdir/*.test]] { if {[catch { exec [info nameofexecutable] $script >@stdout 2>@stderr - set rc 0 } msg opts]} { puts "Failed: $script" + set rc 1 } } exit $rc } else { array set total {pass 0 fail 0 skip 0 tests 0} - foreach script [lsort [glob *.test]] { + foreach script [lsort [glob $testdir/*.test]] { set ::argv0 $script - if {$script eq "signal.test"} { + if {[file tail $script] eq "signal.test"} { # special case, can't run this in a child interpeter catch -exit { source $script @@ -40,15 +42,24 @@ } # Run the test - catch -exit {$i eval source $script} msg opts + catch -exit [list $i eval [list source $script]] msg opts if {[info returncode $opts(-code)] eq "error"} { puts [format "%16s: --- error ($msg)" $script] incr total(fail) + } elseif {[info return $opts(-code)] eq "exit"} { + # if the test explicitly called exit 99, + # it must be from a child process via os.fork, so + # silently exit + if {$msg eq "99"} { + exit 0 + } } # Extract the counts foreach var {pass fail skip tests} { - incr total($var) [$i eval "set testinfo(num$var)"] + catch { + incr total($var) [$i eval "set testinfo(num$var)"] + } } $i delete } diff -Nru jimtcl-0.79+dfsg0/tests/scan.test jimtcl-0.81+dfsg0/tests/scan.test --- jimtcl-0.79+dfsg0/tests/scan.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/scan.test 2021-11-27 23:06:54.000000000 +0000 @@ -244,11 +244,11 @@ catch {unset x} list [scan {xF} {%x} x] [info exists x] } {0 0} -test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} { +test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} jim { set x {} list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z } {3 10 10 16} -test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} { +test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} jim { set x {} list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z } {3 10 10 16} @@ -437,10 +437,10 @@ set a {}; set b {}; set c {}; set d {} list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d } {4 4.6 99999.7 87.643 118.0} -test scan-6.6 {floating-point scanning} jim { +test scan-6.6 {floating-point scanning} -body { set a {}; set b {}; set c {}; set d {} list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d -} {4 1.2345 0.697 124.0 5e-05} +} -match regexp -result {4 1\.2345 0\.697 124.0 5e-0?5} test scan-6.7 {floating-point scanning} { set a {}; set b {}; set c {}; set d {} list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d diff -Nru jimtcl-0.79+dfsg0/tests/signal.test jimtcl-0.81+dfsg0/tests/signal.test --- jimtcl-0.79+dfsg0/tests/signal.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/signal.test 2021-11-27 23:06:54.000000000 +0000 @@ -81,9 +81,9 @@ test signal-1.8 "try/signal" try { signal handle ALRM try -signal { - alarm 0.4 + alarm 0.8 foreach i [range 10] { - sleep 0.1 + sleep 0.2 } set msg "" } on signal {msg} { @@ -92,7 +92,114 @@ alarm 0 } signal default ALRM - list [expr {$i in {3 4 5}}] $msg + list [expr {$i in {2 3 4}}] $msg } {1 SIGALRM} +test signal-1.9 {throw an ignored signal} { + signal ignore SIGTERM + signal throw SIGTERM + signal check -clear SIGTERM +} {SIGTERM} + +test signal-1.10 {throw with no signal} try { + # With no arg, signal throw means signal throw SIGINT + try -signal { + signal throw + } on signal msg { + } + set msg +} SIGINT + +test signal-2.1 {bad signal} -body { + signal handle NONEXISTENT +} -returnCodes error -result {unknown signal NONEXISTENT} + +test signal-2.2 {bad signal} -body { + signal handle 999999 +} -returnCodes error -result {unknown signal 999999} + +test signal-2.3 {signal by number} { + signal handle 2 + signal default 2 +} {} + +test signal-2.4 {signal block} { + signal block SIGINT + signal handle SIGINT + signal default SIGINT +} {} + +test signal-2.5 {signal check invalid} -body { + signal check NONEXISTENT +} -returnCodes error -result {unknown signal NONEXISTENT} + +test signal-2.6 {signal check invalid num} -body { + signal check 999999 +} -returnCodes error -result {unknown signal 999999} + +test signal-2.7 {signal throw invalid} -body { + signal throw NONEXISTENT +} -returnCodes error -result {unknown signal NONEXISTENT} + +test signal-2.8 {signal throw invalid num} -body { + signal throw 999999 +} -returnCodes error -result {unknown signal 999999} + +test signal-2.9 {signal list} { + expr {"SIGINT" in [signal default]} +} {1} + +test alarm-1.1 {alarm usage} -body { + alarm +} -returnCodes error -result {wrong # args: should be "alarm seconds"} + +test alarm-1.2 {alarm usage} -body { + alarm too many args +} -returnCodes error -result {wrong # args: should be "alarm seconds"} + +test alarm-1.3 {alarm usage} -body { + alarm badnum +} -returnCodes error -result {expected floating-point number but got "badnum"} + +test alarm-1.4 {alarm seconds} { + alarm 2 + alarm 0 +} {} + +test sleep-1.1 {sleep usage} -body { + sleep +} -returnCodes error -result {wrong # args: should be "sleep seconds"} + +test sleep-1.2 {sleep usage} -body { + sleep too many args +} -returnCodes error -result {wrong # args: should be "sleep seconds"} + +test sleep-1.3 {sleep usage} -body { + sleep badnum +} -returnCodes error -result {expected floating-point number but got "badnum"} + +test kill-1.1 {kill usage} -body { + kill +} -returnCodes error -result {wrong # args: should be "kill ?SIG|-0? pid"} + +test kill-1.2 {kill usage} -body { + kill too many args +} -returnCodes error -result {wrong # args: should be "kill ?SIG|-0? pid"} + +test kill-1.3 {kill bad signal} -body { + kill NONEXISTENT [pid] +} -returnCodes error -result {unknown signal NONEXISTENT} + +test kill-1.4 {kill -0} { + kill -0 [pid] +} {} + +test kill-1.5 {kill 0 pid} { + kill 0 [pid] +} {} + +test kill-1.6 {kill to invalid process} -body { + kill 0 9999999 +} -returnCodes error -result {kill: Failed to deliver signal} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/socket.test jimtcl-0.81+dfsg0/tests/socket.test --- jimtcl-0.79+dfsg0/tests/socket.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/socket.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,396 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +needs cmd socket +needs cmd os.fork + +catch {[socket -ipv6 stream {[::1]:5000}]} res +set ipv6 1 +if {[string match "*not supported" $res]} { + set ipv6 0 +} else { + # Also, if we can't bind an IPv6 socket, don't run IPv6 tests + if {[catch { + [socket -ipv6 stream.server {[::1]:5000}] close + } msg opts]} { + set ipv6 0 + } +} +testConstraint ipv6 $ipv6 + +# Given an IPv4 or IPv6 server socket, return an address +# that a client can use to connect to the socket. +# This handles the case where the server is listening on (say) 0.0.0.0:5000 +# but some systems need the client to connect on localhost:5000 +proc socket-connect-addr {s} { + if {[regexp {(.*):([^:]+)} [$s sockname] -> host port]} { + if {$host eq "0.0.0.0"} { + return 127.0.0.1:$port + } elseif {$host eq {[::]}} { + return \[::1\]:$port + } + } + return [$s sockname] +} + +test socket-1.1 {stream} -body { + # Let the system choose a port + set s [socket stream.server 127.0.0.1:0] + stdout flush + if {[os.fork] == 0} { + # child + set c [socket stream [$s sockname]] + $s close + $c puts hello + $c close + exit 99 + } + set cs [$s accept] + $cs gets buf + $cs close + $s close + set buf +} -result {hello} + +test socket-1.2 {dgram - connected} -body { + # Let the system choose a port + set s [socket dgram.server 127.0.0.1:0] + set c [socket dgram [$s sockname]] + $s buffering none + $c buffering none + $c puts -nonewline hello + set buf [$s recv 1000] + $c close + $s close + set buf +} -result {hello} + +test socket-1.3 {dgram - unconnected} -body { + # Let the system choose a port + set s [socket dgram.server 127.0.0.1:0] + set c [socket dgram] + $s buffering none + $c buffering none + $c sendto hello [$s sockname] + set buf [$s recv 1000] + $c close + $s close + set buf +} -result {hello} + +test socket-1.4 {unix} -body { + set path [file tempfile] + file delete $path + set s [socket unix.server $path] + stdout flush + if {[os.fork] == 0} { + # child + set c [socket unix [$s sockname]] + $s close + $c puts hello + $c close + exit 99 + } + set cs [$s accept] + $cs gets buf + $cs close + $s close + set buf +} -result {hello} + +test socket-1.5 {unix.dgram} -body { + set path [file tempfile] + file delete $path + set s [socket unix.dgram.server $path] + set c [socket unix.dgram [$s sockname]] + $s buffering none + $c buffering none + $c puts -nonewline hello + set buf [$s recv 1000] + $s close + $c close + set buf +} -result {hello} + +test socket-1.6 {pipe} -body { + lassign [socket pipe] r w + stdout flush + if {[os.fork] == 0} { + $r close + $w puts hello + $w close + exit 99 + } + $w close + $r gets buf + $r close + set buf +} -result {hello} + +test socket-1.7 {socketpair} -body { + lassign [socket pair] s1 s2 + stdout flush + if {[os.fork] == 0} { + $s1 close + # Read data and send it back + $s2 gets buf + $s2 puts $buf + $s2 close + exit 99 + } + $s2 close + $s1 puts hello + $s1 gets buf + $s1 close + set buf +} -result {hello} + +test socket-1.8 {stream - ipv6} -constraints ipv6 -body { + # Let the system choose a port + set s [socket -ipv6 stream.server {[::1]:0}] + stdout flush + if {[os.fork] == 0} { + # child + set c [socket -ipv6 stream [$s sockname]] + $s close + $c puts hello + $c close + exit 99 + } + set cs [$s accept] + $cs gets buf + $cs close + $s close + set buf +} -result {hello} + +test socket-1.9 {dgram - ipv6 - unconnected} -constraints ipv6 -body { + # Let the system choose a port + set s [socket -ipv6 dgram.server {[::1]:0}] + set c [socket -ipv6 dgram] + $s buffering none + $c buffering none + $c sendto hello [$s sockname] + set buf [$s recv 1000] + $c close + $s close + set buf +} -result {hello} + +test socket-1.10 {stream - port only} -body { + set s [socket stream.server 0] + stdout flush + if {[os.fork] == 0} { + # child + set c [socket stream [socket-connect-addr $s]] + $s close + $c puts hello + $c close + exit 99 + } + set cs [$s accept] + $cs gets buf + $cs close + $s close + set buf +} -result {hello} + +test socket-1.11 {stream - ipv6 - port only} -constraints ipv6 -body { + # Let the system choose a port + set s [socket -ipv6 stream.server 0] + stdout flush + if {[os.fork] == 0} { + # child + set c [socket -ipv6 stream [socket-connect-addr $s]] + $s close + $c puts hello + $c close + exit 99 + } + set cs [$s accept] + $cs gets buf + $cs close + $s close + set buf +} -result {hello} + +test socket-2.1 {read 1} -body { + lassign [socket pipe] r w + $w puts -nonewline hello + $w close + set chars {} + while {1} { + set c [$r read 1] + if {$c eq ""} { + break + } + lappend chars $c + } + $r close + set chars +} -result {h e l l o} + +test socket-2.2 {read to EOF} -body { + lassign [socket pipe] r w + $w puts -nonewline hello + $w close + set buf [$r read] + $r close + set buf +} -result {hello} + +test socket-2.3 {read -nonewline} -body { + lassign [socket pipe] r w + $w puts hello + $w close + set buf [$r read -nonewline] + $r close + set buf +} -result {hello} + +test socket-2.4 {isatty} -body { + lassign [socket pipe] r w + set result [list [$r isatty] [$w isatty]] + $r close + $w close + set result +} -result {0 0} + +test socket-2.5 {peername} -body { + set s [socket stream.server 0] + stdout flush + if {[os.fork] == 0} { + try { + set c [socket stream [socket-connect-addr $s]] + $s close + $c puts [list [$c sockname] [$c peername]] + $c close + } on error msg { + stderr puts $msg + } + exit 99 + } + set cs [$s accept] + lassign [$cs gets] c_sockname c_peername + if {$c_sockname ne [$cs peername]} { + error "client sockname=$c_sockname not equal to server peername=[$cs peername]" + } + if {$c_peername ne [$cs sockname]} { + error "client peername=$c_peername not equal to server sockname=[$cs sockname]" + } + $cs close + $s close +} -result {} + +test socket-3.1 {listen} { + set s [socket stream.server 0] + $s listen 10 + $s close +} {} + +test socket-3.2 {listen usage} -body { + set s [socket stream.server 0] + $s listen +} -returnCodes error -match glob -result {wrong # args: should be "* listen backlog"} -cleanup { + $s close +} + +test socket-3.3 {listen usage} -body { + set s [socket stream.server 0] + $s listen blah +} -returnCodes error -match glob -result {expected integer but got "blah"} -cleanup { + $s close +} + +test socket-3.4 {listen not a socket} -body { + set f [open [info script]] + $f listen 10 +} -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup { + $f close +} + +test socket-4.1 {invalid ipv6 address} -constraints ipv6 -body { + socket -ipv6 stream "- invalid - address -" +} -returnCodes error -result {Not a valid address: :::- invalid - address -} + +test socket-4.2 {invalid ipv4 address} -body { + socket stream {9.9.9.9.9:0} +} -returnCodes error -result {Not a valid address: 9.9.9.9.9:0} + +test socket-4.3 {sockname on non-socket} -body { + set f [open [info script]] + $f sockname +} -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup { + $f close +} + +test socket-4.4 {peername on non-socket} -body { + set f [open [info script]] + $f peername +} -returnCodes error -match regexp -result {^(Socket operation on non-socket|Not a socket)$} -cleanup { + $f close +} + +# For the eventloop tests, let's set up a client and a server where the client +# simply echos everything back to the server + +set s [socket stream.server 0] +if {[os.fork] == 0} { + # child + set c [socket stream [socket-connect-addr $s]] + # Note: We have to disable buffering here, otherwise + # when we read data in $c readable {} we many leave buffered + # data and readable won't retrigger. + $c buffering none + $s close + $c readable { + # when we read we need to also read any pending data, + # otherwise readable won't retrigger + set buf [$c read 1] + if {[string length $buf] == 0} { + incr readdone + $c close + } else { + $c puts -nonewline $buf + } + } + vwait readdone + exit 99 +} + +# Now set up the server +set cs [$s accept addr] +defer { + $cs close +} +$s close + +# At this point, $cs is the server connection to the client in the child process + +test eventloop-1.1 {puts/gets} { + $cs puts hello + $cs gets +} hello + +test eventloop-1.2 {puts/gets} { + $cs puts -nonewline again + lmap p [range 5] { + set c [$cs read 1] + set c + } +} {a g a i n} + +test sockopt-1.1 {sockopt} -body { + lsort [dict keys [$cs sockopt]] +} -match glob -result {*tcp_nodelay*} + +test sockopt-1.2 {sockopt set} { + $cs sockopt tcp_nodelay 1 + dict get [$cs sockopt] tcp_nodelay +} 1 + +test sockopt-1.3 {sockopt set invalid} -body { + $cs sockopt tcp_nodelay badbool +} -returnCodes error -result {expected boolean but got "badbool"} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/ssl.test jimtcl-0.81+dfsg0/tests/ssl.test --- jimtcl-0.79+dfsg0/tests/ssl.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/ssl.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,89 @@ +source [file dirname [info script]]/testing.tcl + +needs constraint jim +needs cmd socket +needs cmd os.fork +needs cmd load_ssl_certs + +# Note that we don't actually need to load certificates with load_ssl_certs +# since the openssl installation should generally automatically load +# root certs + +# Let's set up a client and a server where the client +# simply echos everything back to the server + +set s [socket stream.server 127.0.0.1:1443] +if {[os.fork] == 0} { + # child + set c [[socket stream 127.0.0.1:1443] ssl] + $s close + sleep 0.25 + $c readable { + # when we read we need to also read any pending data, + # otherwise readable won't retrigger + set buf [$c read -pending] + if {[string length $buf] == 0} { + incr ssldone + $c close + } else { + $c puts -nonewline $buf + } + } + vwait ssldone + exit 99 +} + +# Now set up the server +set certpath [file dirname [info script]] +set cs [[$s accept addr] ssl -server $certpath/certificate.pem $certpath/key.pem] +$s close +defer { + $cs close +} + +# At this point, $cs is the server connection to the client in the child process + +test ssl-1.1 {puts/gets} { + $cs puts hello + $cs gets +} hello + +test ssl-1.2 {puts/gets} { + $cs puts -nonewline again + lmap p [range 5] { + set c [$cs read 1] + set c + } +} {a g a i n} + +test ssl-2.1 {https to google.com, gets} -body { + set c [[socket stream www.google.com:443] ssl] + $c puts -nonewline "GET / HTTP/1.0\r\n\r\n" + $c flush + set lines {} + while {[$c gets buf] >= 0} { + lappend lines $buf + } + $c close + join $lines \n +} -match glob -result {HTTP/1.0 200 OK*} + +test ssl-2.2 {https to google.com, read with cert verify} -body { + # Note that in order to verify the cert, we need sni + set c [[socket stream www.google.com:443] ssl -sni www.google.com] + # Verify the cert (note that this does not check CN) + $c verify + $c puts -nonewline "GET / HTTP/1.0\r\n\r\n" + $c flush + set buf [$c read] +} -match glob -result {HTTP/1.0 200 OK*} + +test ssl-2.3 {ssl to google.com on port 80} -body { + # Try to talk SSL to a non-SSL server + set c [[socket stream www.google.com:80] ssl] + $c puts -nonewline "GET / HTTP/1.0\r\n\r\n" + $c flush + set buf [$c read] +} -returnCodes error -match glob -result {error:*} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/stacktrace.test jimtcl-0.81+dfsg0/tests/stacktrace.test --- jimtcl-0.79+dfsg0/tests/stacktrace.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/stacktrace.test 2021-11-27 23:06:54.000000000 +0000 @@ -1,6 +1,10 @@ source [file dirname [info script]]/testing.tcl -needs constraint jim; needs cmd package + +needs constraint jim +needs cmd package + package require errors + # Make this a proc so that the line numbers don't have to change proc main {} { set id1 0 @@ -13,12 +17,16 @@ if {[info exists ::expected(err-$id1.$id2)]} { set exp $::expected(err-$id1.$id2) } + if {$type in {package badpackage} && $::tcl_platform(bootstrap)} { + # bootstrap jimsh gives different results, so skip these tests + continue + } test err-$id1.$id2 "Stacktrace on error type $type, method $method" { set rc [catch {error_caller $type $method} msg] #puts "\n-----------------\n$type, $method\n[errorInfo $msg]\n\n" - if {$::SHOW_EXPECTED} { puts stderr "\terr-$id1.$id2 {[list $rc $msg [info stacktrace]]}" } + if {$::SHOW_EXPECTED} { puts stderr "\terr-$id1.$id2 {[list $rc $msg [basename-stacktrace [info stacktrace]]]}" } - list $rc $msg [info stacktrace] + list $rc $msg [basename-stacktrace [info stacktrace]] } $exp } } @@ -29,10 +37,10 @@ test err-10.1 "Stacktrace on error from unknown (badcmd, call)" { set rc [catch {error_caller badcmd call} msg] #puts stderr "err-10.1\n[errorInfo $msg]\n" - #puts stderr "\terr-10.1 {[list $rc $msg [info stacktrace]]}" + #puts stderr "\terr-10.1 {[list $rc $msg [basename-stacktrace [info stacktrace]]]}" - list $rc $msg [info stacktrace] - } {1 {from unknown} {{} stacktrace.test 26 {} errors.tcl 6 error_generator errors.tcl 44 error_caller stacktrace.test 30}} + list $rc $msg [basename-stacktrace [info stacktrace]] + } {1 {from unknown} {{} stacktrace.test 34 {} errors.tcl 6 error_generator errors.tcl 44 error_caller stacktrace.test 38}} rename unknown "" @@ -51,69 +59,69 @@ set g {four} test source-1.1 "Basic line numbers" { - info source $a - } {stacktrace.test 39} + basename-source [info source $a] + } {stacktrace.test 47} test source-1.2 "Line numbers after command with escaped newlines" { - info source $c - } {stacktrace.test 43} + basename-source [info source $c] + } {stacktrace.test 51} test source-1.3 "Line numbers after string with newlines" { - info source $e - } {stacktrace.test 47} + basename-source [info source $e] + } {stacktrace.test 55} test source-1.4 "Line numbers after string with escaped newlines" { - info source $g - } {stacktrace.test 51} + basename-source [info source $g] + } {stacktrace.test 59} } set expected { - err-1.1 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 44 error_caller stacktrace.test 17}} - err-1.2 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 47 error_caller stacktrace.test 17}} - err-1.3 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 50 error_caller stacktrace.test 17}} - err-1.4 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 53 error_caller stacktrace.test 17}} - err-2.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 44 error_caller stacktrace.test 17}} - err-2.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 47 error_caller stacktrace.test 17}} - err-2.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 50 error_caller stacktrace.test 17}} - err-2.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 53 error_caller stacktrace.test 17}} - err-3.1 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 44 error_caller stacktrace.test 17}} - err-3.2 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 47 error_caller stacktrace.test 17}} - err-3.3 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 50 error_caller stacktrace.test 17}} - err-3.4 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 53 error_caller stacktrace.test 17}} - err-4.1 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 44 error_caller stacktrace.test 17}} - err-4.2 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 47 error_caller stacktrace.test 17}} - err-4.3 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 50 error_caller stacktrace.test 17}} - err-4.4 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 53 error_caller stacktrace.test 17}} - err-5.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 44 error_caller stacktrace.test 17}} - err-5.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 47 error_caller stacktrace.test 17}} - err-5.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 50 error_caller stacktrace.test 17}} - err-5.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 53 error_caller stacktrace.test 17}} - err-6.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 44 error_caller stacktrace.test 17}} - err-6.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 47 error_caller stacktrace.test 17}} - err-6.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 50 error_caller stacktrace.test 17}} - err-6.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 53 error_caller stacktrace.test 17}} + err-1.1 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 44 error_caller stacktrace.test 25}} + err-1.2 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 47 error_caller stacktrace.test 25}} + err-1.3 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 50 error_caller stacktrace.test 25}} + err-1.4 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 53 error_caller stacktrace.test 25}} + err-2.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 44 error_caller stacktrace.test 25}} + err-2.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 47 error_caller stacktrace.test 25}} + err-2.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 50 error_caller stacktrace.test 25}} + err-2.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 53 error_caller stacktrace.test 25}} + err-3.1 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 44 error_caller stacktrace.test 25}} + err-3.2 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 47 error_caller stacktrace.test 25}} + err-3.3 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 50 error_caller stacktrace.test 25}} + err-3.4 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 53 error_caller stacktrace.test 25}} + err-4.1 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 44 error_caller stacktrace.test 25}} + err-4.2 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 47 error_caller stacktrace.test 25}} + err-4.3 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 50 error_caller stacktrace.test 25}} + err-4.4 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 53 error_caller stacktrace.test 25}} + err-5.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 44 error_caller stacktrace.test 25}} + err-5.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 47 error_caller stacktrace.test 25}} + err-5.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 50 error_caller stacktrace.test 25}} + err-5.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 53 error_caller stacktrace.test 25}} + err-6.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 44 error_caller stacktrace.test 25}} + err-6.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 47 error_caller stacktrace.test 25}} + err-6.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 50 error_caller stacktrace.test 25}} + err-6.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 53 error_caller stacktrace.test 25}} err-7.1 {1 {from dummyproc -Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 44 error_caller stacktrace.test 17}} +Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 44 error_caller stacktrace.test 25}} err-7.2 {1 {from dummyproc -Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 47 error_caller stacktrace.test 17}} +Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 47 error_caller stacktrace.test 25}} err-7.3 {1 {from dummyproc -Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 50 error_caller stacktrace.test 17}} +Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 50 error_caller stacktrace.test 25}} err-7.4 {1 {from dummyproc -Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 53 error_caller stacktrace.test 17}} - err-8.1 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 44 error_caller stacktrace.test 17}} - err-8.2 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 47 error_caller stacktrace.test 17}} - err-8.3 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 50 error_caller stacktrace.test 17}} - err-8.4 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 53 error_caller stacktrace.test 17}} - err-9.1 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 44 error_caller stacktrace.test 17}} - err-9.2 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 47 error_caller stacktrace.test 17}} - err-9.3 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 50 error_caller stacktrace.test 17}} - err-9.4 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 53 error_caller stacktrace.test 17}} - err-10.1 {1 failure {{} errors.tcl 44 error_caller stacktrace.test 17}} - err-10.2 {1 failure {{} errors.tcl 47 error_caller stacktrace.test 17}} - err-10.3 {1 failure {{} errors.tcl 50 error_caller stacktrace.test 17}} - err-10.4 {1 failure {{} errors.tcl 53 error_caller stacktrace.test 17}} +Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 53 error_caller stacktrace.test 25}} + err-8.1 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 44 error_caller stacktrace.test 25}} + err-8.2 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 47 error_caller stacktrace.test 25}} + err-8.3 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 50 error_caller stacktrace.test 25}} + err-8.4 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 53 error_caller stacktrace.test 25}} + err-9.1 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 44 error_caller stacktrace.test 25}} + err-9.2 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 47 error_caller stacktrace.test 25}} + err-9.3 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 50 error_caller stacktrace.test 25}} + err-9.4 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 53 error_caller stacktrace.test 25}} + err-10.1 {1 failure {{} errors.tcl 44 error_caller stacktrace.test 25}} + err-10.2 {1 failure {{} errors.tcl 47 error_caller stacktrace.test 25}} + err-10.3 {1 failure {{} errors.tcl 50 error_caller stacktrace.test 25}} + err-10.4 {1 failure {{} errors.tcl 53 error_caller stacktrace.test 25}} } # Set this to output expected results to stderr -# in a form which can be pasted into 'expected' below +# in a form which can be pasted into 'expected' above set SHOW_EXPECTED 0 main diff -Nru jimtcl-0.79+dfsg0/tests/stringmatch.test jimtcl-0.81+dfsg0/tests/stringmatch.test --- jimtcl-0.79+dfsg0/tests/stringmatch.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/stringmatch.test 2021-11-27 23:06:54.000000000 +0000 @@ -214,12 +214,20 @@ string match {a[\]]c} {a]c} } 0 -test stringmatch=7.1 {short string with ?} { +test stringmatch-7.1 {short string with ?} { string match {ab?} ab } 0 -test stringmatch=7.1 {multiple * to end} { +test stringmatch-7.2 {multiple * to end} { string match {ab**} ab } 1 +test stringmatch-7.3 {null in string} { + string match *bar* foo\0bar +} 1 + +test stringmatch-7.4 {null in pattern} { + string match *b\[\0a\]r* foobar +} 1 + testreport diff -Nru jimtcl-0.79+dfsg0/tests/string.test jimtcl-0.81+dfsg0/tests/string.test --- jimtcl-0.79+dfsg0/tests/string.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/string.test 2021-11-27 23:06:54.000000000 +0000 @@ -116,6 +116,15 @@ test string-2.29 {string equal with length, unequal strings} { string compare -length 2 ab abde } 0 +test string-2.30 {string compare - bytes vs chars} { + string compare abcd\u1000\u1100\u1200x abcd\u1000\u1100\u1200y +} -1 +test string-2.31 {string compare - embedded nulls} { + string compare ab\0ghi0 ab\0ghi1 +} -1 +test string-2.31 {string compare - embedded nulls, nocase} { + string compare -nocase ab\0ghi0 AB\0GHi1 +} -1 # only need a few tests on equal, since it uses the same code as # string compare, but just modifies the return output test string-3.1 {string equal} { @@ -440,6 +449,9 @@ test string-7.6 {string last} { string las x xxxx123xx345x678 } 12 +test string-7.7 {string last, bad index} { + string last ba badbad -1 +} -1 test string-7.13 {string last, start index} { ## Constrain to last 'a' should work string last ba badbad end-1 @@ -521,6 +533,18 @@ test string-10.17 {string map, one pair case} { string map {Ab 4321} aAbCaBaAbAbcAb } {a4321CaBa43214321c4321} +test string-10.18 {string map, nulls in string} { + string map {a bc} ade\0ghia\0jkl +} "bcde\0ghibc\0jkl" +test string-10.19 {string map, nulls in map source} { + string map {\0 bc} ade\0ghia\0jkl +} "adebcghiabcjkl" +test string-10.20 {string map, nulls in map dest} { + string map {a A\0A} adeghiajkl +} "A\0AdeghiA\0Ajkl" +test string-10.21 {string map, null bytes} { + string map "\u0000afternull #" foo\u0000afternull\u0000123456789bar +} foo#\u0000123456789bar test string-11.1 {string match, too few args} { list [catch {string match a} msg] @@ -675,6 +699,17 @@ string match "\\" "\\" } 0 +test string-11.51 {string match, nulls in pattern} { + string match "abc\0def" "abc\0def" +} 1 + +test string-11.52 {string match, nulls in pattern} { + string match "abc*\0def" "abcghi\0def" +} 1 + +test string-11.53 {string match, nulls in pattern} { + string match "abc\[ghi\0]def" "abc\0def" +} 1 test string-12.1 {string range} { list [catch {string range} msg] @@ -802,10 +837,10 @@ } {} test string-14.13 {string replace} { list [catch {string replace abc abc 1} msg] $msg -} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "abc": must be intexpr or end?[+-]intexpr?}} test string-14.14 {string replace} { list [catch {string replace abc 1 eof} msg] $msg -} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "eof": must be intexpr or end?[+-]intexpr?}} test string-14.15 {string replace} { string replace abcdefghijklmnop end-10 end-2 NEW } {abcdeNEWop} @@ -956,4 +991,44 @@ string cat $abc (def) } {123(def)} +test string-24.1 {string byterange} { + list [catch {string byterange} msg] +} {1} +test string-24.2 {string byterange} { + list [catch {string byterange a 1} msg] +} {1} +test string-24.3 {string byterange} { + list [catch {string byterange a 1 2 3} msg] +} {1} +test string-24.4 {string byterange} { + string byterange abcdefghijklmnop 2 14 +} {cdefghijklmno} +test string-24.5 {string byterange, last > length} { + string byterange abcdefghijklmnop 7 1000 +} {hijklmnop} +test string-24.6 {string byterange} { + string byterange abcdefghijklmnop 10 end +} {klmnop} +test string-24.7 {string byterange, last < first} { + string byterange abcdefghijklmnop 10 9 +} {} +test string-24.8 {string byterange, first < 0} { + string byterange abcdefghijklmnop -3 2 +} {abc} +test string-24.9 {string byterange} { + string byterange abcdefghijklmnop -3 -2 +} {} +test string-24.10 {string byterange, utf8} { + string byterange \u00b5\u00b6 0 1 +} \u00b5 +test string-24.11 {string byterange, slice utf8 } { + string byterange \u00b5\u00b6 1 2 +} \xb5\xc2 +test string-24.12 {string byterange, full range} { + string byterange abcdef 0 end +} abcdef +test string-24.13 {string byterange, invalid range} -body { + string byterange abcdef foo bar +} -returnCodes error -result {bad index "foo": must be intexpr or end?[+-]intexpr?} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/tailcall.test jimtcl-0.81+dfsg0/tests/tailcall.test --- jimtcl-0.79+dfsg0/tests/tailcall.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/tailcall.test 2021-11-27 23:06:54.000000000 +0000 @@ -87,7 +87,7 @@ incr n -1 tailcall a $n } - a 1000 + a 100000 } 1 test tailcall-1.10 {tailcall through uplevel} { diff -Nru jimtcl-0.79+dfsg0/tests/testing.tcl jimtcl-0.81+dfsg0/tests/testing.tcl --- jimtcl-0.79+dfsg0/tests/testing.tcl 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/testing.tcl 2021-11-27 23:06:54.000000000 +0000 @@ -1,12 +1,5 @@ # Find and load the Jim tcltest wrapper -if {[catch {info version}]} { - # Tcl - source [file dirname [info script]]/../tcltest.tcl -} else { - # Jim - if {[exists env(TOPSRCDIR)]} { - set auto_path [list $env(TOPSRCDIR) {*}$auto_path] - } +source [file dirname [info script]]/../tcltest.tcl - package require tcltest -} +# If jimsh is not installed we may also need to include top_srcdir for Tcl modules (.. from this script) +set auto_path [list [file dirname [info script]]/.. {*}$auto_path] diff -Nru jimtcl-0.79+dfsg0/tests/timer.test jimtcl-0.81+dfsg0/tests/timer.test --- jimtcl-0.79+dfsg0/tests/timer.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/timer.test 2021-11-27 23:06:54.000000000 +0000 @@ -23,13 +23,13 @@ after cancel $i } set x "" - foreach i {20 40 200 10 30} { + foreach i {40 80 400 20 60} { after $i lappend x $i } - after 50 + after 100 update set x -} {10 20 30 40} +} {20 40 60 80} test timer-2.1 {Tcl_DeleteTimerHandler procedure} { foreach i [after info] { @@ -62,21 +62,21 @@ foreach i [after info] { after cancel $i } - foreach i {40 120 200} { + foreach i {80 240 400} { after $i lappend x $i } - after 50 + after 100 set result "" set x "" update lappend result $x - after 80 + after 160 update lappend result $x - after 80 + after 160 update lappend result $x -} {40 {40 120} {40 120 200}} +} {80 {80 240} {80 240 400}} test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} { foreach i [after info] { after cancel $i @@ -181,11 +181,11 @@ } {1 {bad argument "gorp": must be cancel, idle, or info}} test timer-6.4 {Tcl_AfterCmd procedure, ms argument} { set x before - after 80 {set x after} - after 40 + after 500 {set x after} + after 100 update set y $x - after 80 + after 500 update list $y $x } {before after} diff -Nru jimtcl-0.79+dfsg0/tests/tty.test jimtcl-0.81+dfsg0/tests/tty.test --- jimtcl-0.79+dfsg0/tests/tty.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/tty.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,56 @@ +source [file dirname [info script]]/testing.tcl + +set havetty 0 +catch { + set havetty [expr {"tty" in [stdout -commands]}] +} +if {!$havetty || ![stdout isatty]} { + skiptest " (aio tty)" +} + +test tty-1.1 {tty status} { + set dict [stdout tty] + dict exists $dict output +} 1 + +test tty-1.2 {tty bad param} -body { + stdout tty bad value +} -returnCodes error -result {bad setting "bad": must be baud, data, echo, handshake, input, output, parity, stop, vmin, or vtime} + +test tty-1.3 {tty bad baud} -body { + stdout tty baud 12345 +} -returnCodes error -result {bad value for baud: 12345} + +test tty-1.4 {tty bad fd} -body { + set f [open [file tempfile] w] + $f tty +} -returnCodes error -match regexp -result {^(Inappropriate ioctl for device|Not a tty)$} -cleanup { + $f close +} + + +set n 0 +foreach {param value} { + output raw + input raw + handshake rtscts +} { + test tty-1.[incr n] "tty setting $param" -setup { + set savetty [stdout tty] + } -body "stdout tty $param $value; dict get \[stdout tty\] $param" \ + -result $value -cleanup { + stdout tty $savetty + } +} + +set n 0 +foreach param {output input handshake baud stop data vmin vtime} { + test tty-2.[incr n] "tty bad setting $param" -setup { + set savetty [stdout tty] + } -body "stdout tty $param bad" \ + -returnCodes error -result "bad value for $param: bad" -cleanup { + stdout tty $savetty + } +} + +testreport diff -Nru jimtcl-0.79+dfsg0/tests/utf8.test jimtcl-0.81+dfsg0/tests/utf8.test --- jimtcl-0.79+dfsg0/tests/utf8.test 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/utf8.test 2021-11-27 23:06:54.000000000 +0000 @@ -149,4 +149,31 @@ string length \u12000 } 2 +test utf8-8.5 {\U} jim { + set x \U000000b5 +} \ub5 + +test utf8-8.6 {\u invalid} { + set x "\u{0000000b5}" +} "u{0000000b5}" + +test utf8-9.1 {string totitle} { + string totitle \u01c4-test +} "\u01c5-test" + +test utf8-9.2 {string totitle} { + string totitle \u01c5-test +} "\u01c5-test" + +test utf8-9.3 {string totitle} { + string totitle abc-\u01c4 +} "Abc-\u01c6" + +# Previously scan was using char length instead of byte length +# when iterating over the string +test utf8-10.1 {scan with utf-8} { + scan ab\u0300c %c%c%c%c a b c d + list $a $b $c $d +} {97 98 768 99} + testreport diff -Nru jimtcl-0.79+dfsg0/tests/xtrace.test jimtcl-0.81+dfsg0/tests/xtrace.test --- jimtcl-0.79+dfsg0/tests/xtrace.test 1970-01-01 00:00:00.000000000 +0000 +++ jimtcl-0.81+dfsg0/tests/xtrace.test 2021-11-27 23:06:54.000000000 +0000 @@ -0,0 +1,62 @@ +source [file dirname [info script]]/testing.tcl + +needs cmd xtrace + +# Simply accumulate the callback args in the list ::lines +proc xtracetest {args} { + lappend ::lines $args +} + +proc xtracesummary {lines} { + # Omit the last line that will always be xtrace {} + # Remove file and line + lmap line [lrange $lines 0 end-1] { + lassign $line type file line result cmd arglist + list $type ($result) $cmd $arglist + } +} + +proc xtracetestproc {a} { + append a " world" + return $a +} + +test xtrace-1.1 {xtrace usage} -body { + xtrace +} -returnCodes error -result {wrong # args: should be "xtrace callback"} + +test xtrace-1.2 {xtrace non-proc} -body { + set lines {} + xtrace xtracetest + set x 3 + xtrace {} + xtracesummary $lines +} -result {{cmd () set {x 3}}} + +# This will produce 4 calls to the trace callback +# 1. xtracetestproc hello (cmd) +# 2. xtracetestproc hello (proc - when executing the proc body) +# 3. append a " hello" +# 4. return "hello world" (previous command result will be "hello world") +test xtrace-1.3 {xtrace proc} -body { + set lines {} + xtrace xtracetest + xtracetestproc hello + xtrace {} + xtracesummary $lines +} -result {{cmd () xtracetestproc hello} {proc () xtracetestproc hello} {cmd () append {a { world}}} {cmd {(hello world)} return {{hello world}}}} + +test xtrace-1.4 {xtrace line numbers} -body { + set lines {} + xtrace xtracetest + set x abc + xtrace {} + # Now the first callback should happen at the correct line number + lassign [lindex $lines 0] - tracefile traceline + lassign [info source $x] file line + if {"$tracefile:$traceline" eq "$file:$line"} { + function ok + } +} -result {ok} + +testreport diff -Nru jimtcl-0.79+dfsg0/.travis.yml jimtcl-0.81+dfsg0/.travis.yml --- jimtcl-0.79+dfsg0/.travis.yml 2019-11-20 19:25:37.000000000 +0000 +++ jimtcl-0.81+dfsg0/.travis.yml 2021-11-27 23:06:54.000000000 +0000 @@ -4,7 +4,9 @@ apt: packages: - libsqlite3-dev + - libhiredis-dev before_script: - - ./configure --full --with-ext="sqlite3 zlib" --disable-docs + - ./configure --maintainer --full --allextmod --disable-docs script: - - make test + - make all test + - ./test-bootstrap-jim