diff options
105 files changed, 6941 insertions, 3207 deletions
diff --git a/.github/workflows/codeql.yml b/.github/workflows/codeql.yml index 8164922..c031346 100644 --- a/.github/workflows/codeql.yml +++ b/.github/workflows/codeql.yml @@ -12,8 +12,8 @@ name: "CodeQL" on: - # push: - # branches: [ "main", "master" ] + push: + branches: [ "master" ] schedule: - cron: '0 0 * * *' pull_request: @@ -27,7 +27,7 @@ jobs: # - https://gh.io/supported-runners-and-hardware-resources # - https://gh.io/using-larger-runners # Consider using larger runners for possible analysis time improvements. - runs-on: ${{ (matrix.language == 'swift' && 'macos-latest') || 'ubuntu-20.04' }} + runs-on: ${{ (matrix.language == 'swift' && 'macos-latest') || 'ubuntu-latest' }} timeout-minutes: ${{ (matrix.language == 'swift' && 120) || 360 }} permissions: actions: read @@ -51,7 +51,7 @@ jobs: # Initializes the CodeQL tools for scanning. - name: Initialize CodeQL - uses: github/codeql-action/init@v2 + uses: github/codeql-action/init@v3 with: languages: ${{ matrix.language }} # If you wish to specify custom queries, you can do so here or in a config file. @@ -66,7 +66,7 @@ jobs: # Autobuild attempts to build any compiled languages (C/C++, C#, Go, Java, or Swift). # If this step fails, then you should remove it and run the build manually (see below) #- name: Autobuild - # uses: github/codeql-action/autobuild@v2 + # uses: github/codeql-action/autobuild@v3 # âšī¸ Command-line programs to run using the OS shell. # đ See https://docs.github.com/en/actions/using-workflows/workflow-syntax-for-github-actions#jobsjob_idstepsrun @@ -78,7 +78,7 @@ jobs: ./.github/workflows/codeql-buildscript.sh - name: Perform CodeQL Analysis - uses: github/codeql-action/analyze@v2 + uses: github/codeql-action/analyze@v3 with: category: "/language:${{matrix.language}}" upload: false @@ -107,14 +107,14 @@ jobs: output: ${{ steps.step1.outputs.sarif-output }}/cpp.sarif - name: Upload CodeQL results to code scanning - uses: github/codeql-action/upload-sarif@v2 + uses: github/codeql-action/upload-sarif@v3 with: sarif_file: ${{ steps.step1.outputs.sarif-output }} category: "/language:${{matrix.language}}" - name: Upload CodeQL results as an artifact if: success() || failure() - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: codeql-results path: ${{ steps.step1.outputs.sarif-output }} diff --git a/.github/workflows/fail_on_error.py b/.github/workflows/fail_on_error.py index 2979174..bb50e2d 100755 --- a/.github/workflows/fail_on_error.py +++ b/.github/workflows/fail_on_error.py @@ -11,7 +11,10 @@ def codeql_sarif_contain_error(filename): for run in s.get('runs', []): rules_metadata = run['tool']['driver']['rules'] if not rules_metadata: - rules_metadata = run['tool']['extensions'][0]['rules'] + for ext in run['tool']['extensions']: + if ext['name'] == 'codeql/cpp-queries': + rules_metadata = ext['rules'] + break for res in run.get('results', []): if 'ruleIndex' in res: diff --git a/.github/workflows/makefile.yml b/.github/workflows/makefile.yml index a6c4ab8..43f2c88 100644 --- a/.github/workflows/makefile.yml +++ b/.github/workflows/makefile.yml @@ -2,7 +2,7 @@ name: Makefile CI on: push: - branches: [ "master" ] + branches: [ "master", "master-next" ] pull_request: branches: [ "master" ] @@ -15,9 +15,11 @@ jim-oo.c jimsh *.exe libjim.a +*.so *.so.* *.dll *.o +*.dylib configure.gnu jimsh0 build-jim-ext diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..b71829c --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,65 @@ +# Contributing to Jim + +Please take a moment to review this document in order to make the contribution +process easy and effective for everyone involved. + +Following these guidelines helps to communicate that you respect the time of +the developers managing and developing this open source project. In return, +they should reciprocate that respect in addressing your issue, assessing +changes, and helping you finalize your pull requests. + +## Bug reports and Feature requests + +The [issue tracker](https://github.com/msteveb/jimtcl/issues) is the preferred channel for bug reports +and features requests. + +## Discussions + +If you wish to open a broader topic for discussion, consider using a [discussion topic](https://github.com/msteveb/jimtcl/discussions) + +## Pull requests + +[Pull requests](https://github.com/msteveb/jimtcl/pulls) are always welcome + +If you have never created a pull request before, [Here is a great tutorial](https://egghead.io/series/how-to-contribute-to-an-open-source-project-on-github) +on how to create a pull request. + +1. [Fork](http://help.github.com/fork-a-repo/) the project, clone your fork, + and configure the remotes: + + ``` + # Clone your fork of the repo into the current directory + git clone https://github.com/<your-username>/<repo-name> + # Navigate to the newly cloned directory + cd <repo-name> + # Assign the original repo to a remote called "upstream" + git remote add upstream https://github.com/msteveb/jimtcl.git + ``` + +2. If you cloned a while ago, get the latest changes from upstream: + + ``` + git checkout master + git pull upstream master + ``` + +3. Create a new topic branch (off the main project development branch) to + contain your feature, change, or fix: + + ```bash + git checkout -b <topic-branch-name> + ``` + +4. Make sure to update, or add to the tests when appropriate. + Run `make test` to check that all tests pass after you've made changes. + +5. If you added or changed a feature, please add documentation to jim_tcl.txt. + +6. Push your topic branch up to your fork: + + ```bash + git push origin <topic-branch-name> + ``` + +7. [Open a Pull Request](https://help.github.com/articles/using-pull-requests/) + with a clear title and description. diff --git a/DEVELOPING b/DEVELOPING deleted file mode 100644 index 5156b28..0000000 --- a/DEVELOPING +++ /dev/null @@ -1,93 +0,0 @@ -Working on Jim -============== - -Jim's sources are kept in Git Version Control System. Global repository of -Jim project is placed on this Web site: - - http://repo.or.cz/w/jimtcl.git - -There are two ways of contributing to Jim project. First is suited for -one-time fixes and small corrections. The second is more appropriate -for long-term contributors interested in Jim internals. - -Small changes -============= - -For small modifications, procedure of preparing a traditional 'patch' -is enough. In order to prepare a patch, you first have to obtain the -most recent copy of Jim Tcl. This can be done with following command: - - git clone http://repo.or.cz/r/jimtcl.git - -After entering newly created directory you can easily correct/fix/modify -files. Once finished, patch can be easily generated: - - git diff > my_patch_fixing_x_y.patch - -If working without Git system, you'll have to backup files first, modify -the original files and obtain a patch manually: - - cp jim.c jim.c.ORIGINAL - - [...] <- modifications go here - - diff -u jim.c.ORIGINAL jim.c > my_patch_fixing_z.patch - -Bigger changes -============== - -In order to help extending and correcting Jim in a long term basis, one -needs to create separate fork of Jim project and maintain his changes in a -separate copy of a repository. - -By visiting this site, you'll have a chance to fork a project. This can -be easily done with "fork" link. Form that will show up next refers to -the project that is about to be started. The only thing that has to be -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 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 -start playing with actual import of the files. In order to obtain copy -of Jim sources, we have to clone the repository: - - git clone http://repo.or.cz/r/jimtcl.git - -Now, we must push fresh copy of Jim to your project URL: - - git push <URL> master - -So for example for me it was: - - git push ssh://repo.or.cz/srv/git/jimtcl/wkoszek.git master - -In order to add file we type "git add <file>". For remove, we do "git rm -<file>". To remove all local changes that aren't in a repository you do "git -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 anonymous HTTP -access: - - git clone http://repo.or.cz/r/jimtcl/wkoszek.git - -Review, testing and publishing -============================== - -Notification of work that can be considered finished is more than welcome on -Jim-devel mailing list: - - http://jim.tcl.tk:8080/cgi-bin/mailman/listinfo/jim-devel - -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: - - make test - -All tests should succeed. diff --git a/Makefile.in b/Makefile.in index 29c226b..2fba1c0 100644 --- a/Makefile.in +++ b/Makefile.in @@ -118,7 +118,9 @@ install: all @TCL_EXTS@ install-exec install-docs @srcdir@/jim-subcmd.h @srcdir@/jim-win32compat.h $(DESTDIR)@includedir@ $(INSTALL_DATA) jim-config.h $(DESTDIR)@includedir@ $(INSTALL_DATA_DIR) $(DESTDIR)@bindir@ +@if BUILD_JIM_EXT $(INSTALL_DATA) build-jim-ext $(DESTDIR)@bindir@ +@endif $(INSTALL_DATA_DIR) $(DESTDIR)@libdir@/pkgconfig $(INSTALL_DATA) jimtcl.pc $(DESTDIR)@libdir@/pkgconfig diff --git a/README.namespaces b/README.namespaces index ef50769..9d23a74 100644 --- a/README.namespaces +++ b/README.namespaces @@ -115,6 +115,7 @@ Currently, the following namespace commands are supported. * delete - deletes all variables and commands with the namespace prefix * which - implemented * upvar - implemented +* ensemble - 'create' command is implemented namespace children, exists, path -------------------------------- @@ -126,12 +127,6 @@ or variable in the namespace. Command resolution is always done by first looking in the namespace and then at the global scope, so namespace path is not required. -namespace ensemble ------------------- -The namespace ensemble command is not currently supported. A future version -of Jim Tcl will have a general-purpose ensemble creation and manipulation -mechanism and namespace ensemble will be implemented in terms of that mechanism. - namespace import, export, forget, origin ---------------------------------------- Since Jim Tcl namespaces are implicit, there is no location to store export patterns. diff --git a/README.taint b/README.taint new file mode 100644 index 0000000..a10e4ff --- /dev/null +++ b/README.taint @@ -0,0 +1,143 @@ +Taint Suport for Jim Tcl +======================== + +Author: Steve Bennett <steveb@workware.net.au> +Date: 24 May 2011 + +OVERVIEW +-------- +Perl and Ruby support the concept of tainted data, taint sources +and taint sinks. The idea is to improve security in situations +where data may be coming from outside the program (e.g. input +to a web application). This data should not inadvertently be output +on a web page unescaped (to avoid XSS attacks), to a database +(to avoid SQL injections attacks) or to execute system commands +(to avoid system attacks). + +Standard Tcl does not support tainting, but uses "safe" +interpreters for a similar purpose. For Jim Tcl, taint support is +smaller and simpler. + +HOW IT WORKS +------------ + +Any data read from a 'taint source' is considered tainted. +As that data moves through the system, it retains its taint property. +Tainted data should not be allowed to be consumed by a 'taint sink'. +An error should be raised instead. + +Taint Sources +~~~~~~~~~~~~~ +Untrusted data may come from various sources in the system. +In Jim Tcl, the sources of external data are: + +* Data read from a file or socket (aio read, gets, recvfrom) +* Command line arguments ($argv) +* Loaded code or scripts (source, package require, load) +* Environment variables (env) +* Custom Tcl commands implemented as C code + +Any data from these sources may be considered "tainted". + +By default, sockets are considered taint sources while the other +external data sources are not. Data read from a 'taint source' +filehandle with read, recvfrom or gets is tainted. + +No filehandles are considered taint sinks by default. + +Client sockets produced by accept inherit the accept socket settings. + +Taint Sinks +~~~~~~~~~~~ +In order for tainted data to cause security problems, the data +need to be used in certain contexts. These *may* include: + +* Establishing network connections (socket) +* Sending the data to certain file descriptors (aio puts, sendto) +* Modifying the filesystem (open, file delete, rename, mkdir) +* Running commands (exec) +* Evaluating scripts (eval, uplevel, source) +* Use in custom Tcl commands implemented as C code + +Taint Propagation +~~~~~~~~~~~~~~~~~ +As tainted data is assigned, or manipulated, it should retain +its taint property. This includes the creation of new values +based on tainted data. Jim Tcl takes a conservative approach +to taint propagation as follows: + +* Any copy of a tainted value is tainted (e.g. set, proc calls) +* Any value constructed in part from a tainted value is tainted + (append, lappend, lset) +* A tainted value added to a container (dict, list, array) remains tainted. + If the tainted value can be distinguished from other values + in the container, the container is not tainted. However, if the container + needs to change representation, the entire container becomes tainted. +* Integer and floating point values are not tainted + +Taint types +----------- +It may be useful to distinguish between different types of taint. +Each taint type is assigned a bit in a taint bit field. The standard taint +type is 1, but taint types 2, 4, etc. may also be used. If a taint +source is marked as taint type 2, it will not be flagged as invalid +when consumed by a taint sink marked as taint type 4. + +The commands exec, source, etc. consider any taint to be invalid, however +file descriptors may have specific taint source and sink types specified. + +Taint-aware Commands +-------------------- +The following commands will fail if any argument is tainted: + +- source, exec, open, socket, load, file mkdir, file delete, file rename + +In addition, 'package require' will ignore any tainted paths in $auto_path + +HOW TO USE IT +------------- +To mark a value as tainted: + + taint varname + +To remove the taint from a value: + + untaint varname + +To determine if a value is tainted: + + info tainted $var + +To mark a filehandle as a taint source or sink (or not): + + $aiohandle taint source|sink ?0|n? + +More Information +---------------- +To simplify taint propagation, the interpreter examines the arguments +to every command (plus the command itself). If any argument is +tainted, the command execution is considered tainted. Any new +objects (except int and double) created during the execution of the +command will be marked tainted. + +The Rules +--------- +- The taint and untaint commands operate on variables, and taint/untaint the contents of the variable +- Adding/modifying a list/dict/array element taints that element plus the "container", but not + the other elements in that container +- Tainting a container element taints the container too +- Untainting a container element does not untaint the container, even if it contains no more tainted elements +- Tainting or untainting a container taints or untaints all elements in the container +- Any element of $auto_path that is tainted will be ignored when loading packages with package require + +Specific Notes +-------------- +In general, a conservative approach is used to tainting, so if +a command creates a new object while any of its arguments are tainted, +the new object is also tainted. + +However, the list-related commands are more intelligent. +All list-related commands such as lindex, lrange, lassign and lreplace will +not change the taint of existing list elements, but will avoid tainting untainted elements. +For example, if the list {a b t d} contains one tainted element, 't', then [lreverse $a] +will produce a list with only one tainted element. diff --git a/Tcl_shipped.html b/Tcl_shipped.html index 0f68a95..38843a0 100644 --- a/Tcl_shipped.html +++ b/Tcl_shipped.html @@ -4,7 +4,7 @@ <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
-<meta name="generator" content="AsciiDoc 10.2.0" />
+<meta name="generator" content="AsciiDoc 10.2.1" />
<title>Jim Tcl(n)</title>
<style type="text/css">
/* Shared CSS for AsciiDoc xhtml11 and html5 backends */
@@ -739,7 +739,7 @@ Jim Tcl(n) Manual Page </h1>
<h2>NAME</h2>
<div class="sectionbody">
-<p>Jim Tcl v0.82 -
+<p>Jim Tcl v0.83+ -
reference manual for the Jim Tcl scripting language
</p>
</div>
@@ -800,7 +800,7 @@ Object-based I/O (aio), but with a Tcl-compatibility layer </li>
<li>
<p>
-I/O: Support for sockets and pipes including udp, unix domain sockets and IPv6
+I/O: Support for sockets and pipes including TCP, UDP, UNIX-Domain sockets and IPv6
</p>
</li>
<li>
@@ -850,7 +850,7 @@ Command and variable traces are not supported </li>
<li>
<p>
-Built-in command line editing
+Built-in command line editing in interactive mode with autocompletion and hints
</p>
</li>
<li>
@@ -870,7 +870,7 @@ Highly suitable for use in an embedded environment </li>
<li>
<p>
-Support for UDP, IPv6, Unix-Domain sockets in addition to TCP sockets
+Jim does not convert backslash-newline within braces (in order to preserve accurate line numbers)
</p>
</li>
</ol></div>
@@ -880,6 +880,131 @@ Support for UDP, IPv6, Unix-Domain sockets in addition to TCP sockets <h2 id="_recent_changes">RECENT CHANGES</h2>
<div class="sectionbody">
<div class="sect2">
+<h3 id="_changes_since_0_83">Changes since 0.83</h3>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+<a href="#_aio"><strong><code>aio</code></strong></a> - support for configurable read and write buffering
+</p>
+</li>
+<li>
+<p>
+Add support for <a href="#_package"><strong><code>package</code></strong></a> <code>forget</code>
+</p>
+</li>
+<li>
+<p>
+Add <a href="#_aio"><strong><code>aio</code></strong></a> <code>translation</code> support (and fconfigure -translation)
+</p>
+</li>
+<li>
+<p>
+<a href="#_exec"><strong><code>exec</code></strong></a> <a href="https://core.tcl-lang.org/tips/doc/main/tip/424.md">TIP 424</a> - support safer <code><em>exec |</em></code> syntax (also <code><em>open "|| pipeline…"</em></code>)
+</p>
+</li>
+<li>
+<p>
+New <a href="#_lsubst"><strong><code>lsubst</code></strong></a> command to create lists using subst-style substitution
+</p>
+</li>
+<li>
+<p>
+Add support for <a href="#_regexp"><strong><code>regexp</code></strong></a> <code>-expanded</code> and <a href="#_regsub"><strong><code>regsub</code></strong></a> <code>-expanded</code>
+</p>
+</li>
+<li>
+<p>
+<a href="#cmd_2"><strong><code>vwait</code></strong></a> now accepts a script argument
+</p>
+</li>
+<li>
+<p>
+Add support for <a href="#cmd_1"><strong><code>os.umask</code></strong></a>
+</p>
+</li>
+<li>
+<p>
+Add <a href="#_taint"><strong><code>taint</code></strong></a> support for improved data security
+</p>
+</li>
+<li>
+<p>
+Improved API for creating C commands with <code><em>Jim_RegisterCommand</em></code> for arg checking and usage
+</p>
+</li>
+<li>
+<p>
+New <a href="#_info"><strong><code>info</code></strong></a> <code>usage</code> to return the usage for a proc or native command
+</p>
+</li>
+<li>
+<p>
+New <a href="#_info"><strong><code>info</code></strong></a> <code>aliases</code> to list all aliases
+</p>
+</li>
+<li>
+<p>
+<a href="#_expr"><strong><code>expr</code></strong></a> supports new <code><em>=*</em></code> and <code><em>=~</em></code> matching operators (see <a href="#_expressions">EXPRESSIONS</a>)
+</p>
+</li>
+</ol></div>
+</div>
+<div class="sect2">
+<h3 id="_changes_between_0_82_and_0_83">Changes between 0.82 and 0.83</h3>
+<div class="olist arabic"><ol class="arabic">
+<li>
+<p>
+Multi-level <a href="#_break"><strong><code>break</code></strong></a> and <a href="#_continue"><strong><code>continue</code></strong></a> are now supported
+</p>
+</li>
+<li>
+<p>
+<a href="#_info"><strong><code>info</code></strong></a> <code>frame</code> now only returns <em>proc</em> levels
+</p>
+</li>
+<li>
+<p>
+<a href="#_stacktrace"><strong><code>stacktrace</code></strong></a> is now a builtin command
+</p>
+</li>
+<li>
+<p>
+The stack trace on error now includes the full stack trace, not just back to where it was caught
+</p>
+</li>
+<li>
+<p>
+Improvements with <a href="#_aio"><strong><code>aio</code></strong></a>, related to eventloop and buffering. Add <a href="#_aio"><strong><code>aio</code></strong></a> <code>timeout</code>.
+</p>
+</li>
+<li>
+<p>
+<a href="#_socket"><strong><code>socket</code></strong></a> , <a href="#_open"><strong><code>open</code></strong></a> and <a href="#_aio"><strong><code>aio</code></strong></a> <code>accept</code> now support <em>-noclose</em>
+</p>
+</li>
+<li>
+<p>
+Add support for hinting with <a href="#_history"><strong><code>history</code></strong></a> <code>hints</code>
+</p>
+</li>
+<li>
+<p>
+Support for <a href="#_proc"><strong><code>proc</code></strong></a> statics by reference (lexical closure) rather than by value
+</p>
+</li>
+<li>
+<p>
+<a href="#_regsub"><strong><code>regsub</code></strong></a> now supports <em>-command</em> (per Tcl 8.7)
+</p>
+</li>
+<li>
+<p>
+Add support for <a href="#_lsort"><strong><code>lsort</code></strong></a> <code>-dict</code>
+</p>
+</li>
+</ol></div>
+</div>
+<div class="sect2">
<h3 id="_changes_between_0_81_and_0_82">Changes between 0.81 and 0.82</h3>
<div class="olist arabic"><ol class="arabic">
<li>
@@ -889,7 +1014,7 @@ Support for UDP, IPv6, Unix-Domain sockets in addition to TCP sockets </li>
<li>
<p>
-TIP 603, <a href="#_aio"><strong><code>aio</code></strong></a> <code>stat</code> is now supported to stat a file handle
+<a href="https://core.tcl-lang.org/tips/doc/main/tip/603.md">TIP 603</a>, <a href="#_aio"><strong><code>aio</code></strong></a> <code>stat</code> is now supported to stat a file handle
</p>
</li>
<li>
@@ -919,7 +1044,7 @@ The handles created by <a href="#_socket"><strong><code>socket</code></strong></ </li>
<li>
<p>
-New <a href="#_timerate"><strong><code>timerate</code></strong></a> command as an improvement over <a href="#_time"><strong><code>time</code></strong></a>, somewhat compatible with TIP 527
+New <a href="#_timerate"><strong><code>timerate</code></strong></a> command as an improvement over <a href="#_time"><strong><code>time</code></strong></a>, somewhat compatible with <a href="https://core.tcl-lang.org/tips/doc/main/tip/527.md">TIP 527</a>
</p>
</li>
<li>
@@ -934,7 +1059,7 @@ Add <a href="#_ensemble"><strong><code>ensemble</code></strong></a> command and <div class="olist arabic"><ol class="arabic">
<li>
<p>
-TIP 582, comments allowed in expressions
+<a href="https://core.tcl-lang.org/tips/doc/main/tip/582.md">TIP 582</a>, comments allowed in expressions
</p>
</li>
<li>
@@ -965,7 +1090,7 @@ Add <a href="#_history"><strong><code>history</code></strong></a> <code>keep</co </li>
<li>
<p>
-Add support for <a href="#_lsearch"><strong><code>lsearch</code></strong></a> <code>-index</code> and <a href="#_lsearch"><strong><code>lsearch</code></strong></a> <code>-stride</code>, the latter per TIP 351
+Add support for <a href="#_lsearch"><strong><code>lsearch</code></strong></a> <code>-index</code> and <a href="#_lsearch"><strong><code>lsearch</code></strong></a> <code>-stride</code>, the latter per <a href="https://core.tcl-lang.org/tips/doc/main/tip/351.md">TIP 351</a>
</p>
</li>
<li>
@@ -985,7 +1110,7 @@ Add support for <a href="#_lsort"><strong><code>lsort</code></strong></a> <code> </li>
<li>
<p>
-TIP 526, <a href="#_expr"><strong><code>expr</code></strong></a> now only allows a single argument (unless --compat is enabled)
+<a href="https://core.tcl-lang.org/tips/doc/main/tip/526.md">TIP 526</a>, <a href="#_expr"><strong><code>expr</code></strong></a> now only allows a single argument (unless --compat is enabled)
</p>
</li>
</ol></div>
@@ -1015,17 +1140,17 @@ dictionaries and arrays now preserve insertion order, matching Tcl and the docum </li>
<li>
<p>
-Add <a href="#_dict"><strong><code>dict</code></strong></a> <code>getwithdefault</code> (and the alias <a href="#_dict"><strong><code>dict</code></strong></a> <code>getdef</code>) per TIP 342
+Add <a href="#_dict"><strong><code>dict</code></strong></a> <code>getwithdefault</code> (and the alias <a href="#_dict"><strong><code>dict</code></strong></a> <code>getdef</code>) per <a href="https://core.tcl-lang.org/tips/doc/main/tip/342.md">TIP 342</a>
</p>
</li>
<li>
<p>
-Add string comparison operators (lt, gt, le, ge) per TIP 461
+Add string comparison operators (lt, gt, le, ge) per <a href="https://core.tcl-lang.org/tips/doc/main/tip/461.md">TIP 461</a>
</p>
</li>
<li>
<p>
-Implement 0d radix prefix for decimal per TIP 472
+Implement <code>0d</code> radix prefix for decimal per <a href="https://core.tcl-lang.org/tips/doc/main/tip/472.md">TIP 472</a>
</p>
</li>
</ol></div>
@@ -1419,7 +1544,7 @@ that command. For example, the command:</p></div> the last two, <em>a</em> and <em>22</em>, will be passed as arguments to
the <a href="#_set"><strong><code>set</code></strong></a> command. The command name may refer either to a built-in
Tcl command, an application-specific command bound in with the library
-procedure <em>Jim_CreateCommand</em>, or a command procedure defined with the
+procedure <em>Jim_RegisterCommand</em>, or a command procedure defined with the
<a href="#_proc"><strong><code>proc</code></strong></a> built-in command.</p></div>
<div class="paragraph"><p>Arguments are passed literally as text strings. Individual commands may
interpret those strings in any fashion they wish. The <a href="#_set"><strong><code>set</code></strong></a> command,
@@ -1705,94 +1830,20 @@ sequence is replaced by the given character:</p></div> </p>
</dd>
<dt class="hdlist1">
-<code>\{</code>
-</dt>
-<dd>
-<p>
- Left brace ({).
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\}</code>
-</dt>
-<dd>
-<p>
- Right brace (}).
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\[</code>
-</dt>
-<dd>
-<p>
- Open bracket ([).
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\]</code>
-</dt>
-<dd>
-<p>
- Close bracket (]).
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\$</code>
-</dt>
-<dd>
-<p>
- Dollar sign ($).
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\<space></code>
-</dt>
-<dd>
-<p>
- Space ( ): doesn’t terminate argument.
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\;</code>
-</dt>
-<dd>
-<p>
- Semi-colon: doesn’t terminate command.
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\"</code>
-</dt>
-<dd>
-<p>
- Double-quote.
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\<newline></code>
+<code>\ddd</code>
</dt>
<dd>
<p>
- Nothing: this joins two lines together
- into a single line. This backslash feature is unique in that
- it will be applied even when the sequence occurs within braces.
+ The digits <code><em>ddd</em></code> (one, two, or three of them) give the octal value of
+ the byte. Note that Jim supports null characters in strings.
</p>
</dd>
<dt class="hdlist1">
-<code>\\</code>
+<code>\xnn</code>
</dt>
<dd>
<p>
- Backslash (<em>\</em>).
-</p>
-</dd>
-<dt class="hdlist1">
-<code>\ddd</code>
-</dt>
-<dd>
-<p>
- The digits <code><em>ddd</em></code> (one, two, or three of them) give the octal value of
- the character. Note that Jim supports null characters in strings.
+ The hexidecimal digits <code><em>nn</em></code> give the value of the byte.
</p>
</dd>
<dt class="hdlist1">
@@ -1810,30 +1861,23 @@ sequence is replaced by the given character:</p></div> The <em>u</em> form allows for one to four hex digits.
The <em>U</em> form allows for one to eight hex digits.
The <em>u{nnn}</em> form allows for one to eight hex digits, but makes it easier to insert
- characters UTF-8 characters which are followed by a hex digit.
+ UTF-8 characters that are followed by a hex digit.
</p>
</dd>
</dl></div>
-<div class="paragraph"><p>For example, in the command</p></div>
-<div class="listingblock">
-<div class="content">
-<pre><code> set a {x\[\ yz\141</code></pre>
-</div></div>
-<div class="paragraph"><p>the second argument to <a href="#_set"><strong><code>set</code></strong></a> will be <code>{x[ yza</code>.</p></div>
<div class="paragraph"><p>If a backslash is followed by something other than one of the options
-described above, then the backslash is transmitted to the argument
-field without any special processing, and the Tcl scanner continues
+described above, the backslash is skipped and character following the backslash is treated
+as a normal character without any special meaning. The Tcl scanner continues
normal processing with the next character. For example, in the
command</p></div>
+<div class="paragraph"><p>For example, in the command</p></div>
<div class="listingblock">
<div class="content">
-<pre><code> set \*a \\{foo</code></pre>
+<pre><code> set a \{x\[\ yz\141</code></pre>
</div></div>
-<div class="paragraph"><p>The first argument to <a href="#_set"><strong><code>set</code></strong></a> will be <code>\*a</code> and the second
-argument will be <code>{foo</code>.</p></div>
+<div class="paragraph"><p>the second argument to <a href="#_set"><strong><code>set</code></strong></a> will be <code>{x[ yza</code>.</p></div>
<div class="paragraph"><p>If an argument is enclosed in braces, then backslash sequences inside
-the argument are parsed but no substitution occurs (except for
-backslash-newline): the backslash
+the argument are parsed but no substitution occurs: the backslash
sequence is passed through to the argument as is, without making
any special interpretation of the characters in the backslash sequence.
In particular, backslashed braces are not counted in locating the
@@ -1842,9 +1886,9 @@ For example, in the command</p></div>
<div class="listingblock">
<div class="content">
-<pre><code> set a {{abc}</code></pre>
+<pre><code> set a {\{abc}</code></pre>
</div></div>
-<div class="paragraph"><p>the second argument to <a href="#_set"><strong><code>set</code></strong></a> will be <code>{abc</code>.</p></div>
+<div class="paragraph"><p>the second argument to <a href="#_set"><strong><code>set</code></strong></a> will be <code>\{abc</code>.</p></div>
<div class="paragraph"><p>This backslash mechanism is not sufficient to generate absolutely
any argument structure; it only covers the
most common cases. To produce particularly complicated arguments
@@ -2036,14 +2080,10 @@ it).</p></div> <div class="paragraph"><p>String constants representing boolean constants
(<code><em>0</em></code>, <code><em>1</em></code>, <code><em>false</em></code>, <code><em>off</em></code>, <code><em>no</em></code>, <code><em>true</em></code>, <code><em>on</em></code>, <code><em>yes</em></code>)
are also recognized and can be used in logical operations.</p></div>
+<div class="paragraph"><p>Operands may be specified in any of the following ways:</p></div>
<div class="olist arabic"><ol class="arabic">
<li>
<p>
-Operands may be specified in any of the following ways:
-</p>
-</li>
-<li>
-<p>
As a numeric value, either integer or floating-point.
</p>
</li>
@@ -2241,6 +2281,24 @@ of precedence:</p></div> </p>
</dd>
<dt class="hdlist1">
+<code>=*</code>
+</dt>
+<dd>
+<p>
+ String glob match. The left and side is the string to match and the right
+ and side is the pattern. See <a href="#_string_matching">STRING MATCHING</a>.
+</p>
+</dd>
+<dt class="hdlist1">
+<code>=~</code>
+</dt>
+<dd>
+<p>
+ String regexp match. The left and side is the string to match and the right
+ and side is the regular expression. See <a href="#_regular_expressions">REGULAR EXPRESSIONS</a>.
+</p>
+</dd>
+<dt class="hdlist1">
<code>in ni</code>
</dt>
<dd>
@@ -2683,6 +2741,15 @@ defined in jim.h, and are:</p></div> The string contains the exit code.
</p>
</dd>
+<dt class="hdlist1">
+<code>JIM_USAGE(-1)</code>
+</dt>
+<dd>
+<p>
+ This is a special return code that is automatically translated into JIM_ERR with the command usage
+ (from Jim_RegisterCommand()) as the message.
+</p>
+</dd>
</dl></div>
<div class="paragraph"><p>Tcl programmers do not normally need to think about return codes,
since <code>JIM_OK</code> is almost always returned. If anything else is returned
@@ -2897,6 +2964,24 @@ is no variable with the same name in the enclosing scope). However <code><em>b</ has an initialiser, so it is initialised to 2.</p></div>
<div class="paragraph"><p>Unlike a local variable, the value of a static variable is retained across
invocations of the procedure.</p></div>
+<div class="paragraph"><p>In addition to static variables by value, static variables may also be
+defined by "reference" by using a leading "&" character. In this case,
+the statics point to the original variable and when one changes, they
+both change. For example, here <em>a</em> changes changes the value of the
+original <em>x</em>.</p></div>
+<div class="listingblock">
+<div class="content">
+<pre><code> . set x 1
+ . proc a {} {&x} {
+ incr x
+ }
+ . a
+ 2
+ . a
+ 3
+ . puts $x
+ 3</code></pre>
+</div></div>
<div class="paragraph"><p>See the <a href="#_proc"><strong><code>proc</code></strong></a> command for information on how to define procedures
and what happens when they are invoked. See also <a href="#_namespaces">NAMESPACES</a>.</p></div>
</div>
@@ -3364,89 +3449,89 @@ cellspacing="0" cellpadding="4"> <td align="left" valign="top"><p class="table"><a href="#_lsearch"><strong><code>lsearch</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_lset"><strong><code>lset</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_lsort"><strong><code>lsort</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_lsubst"><strong><code>lsubst</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_namespace"><strong><code>namespace</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_4"><strong><code>oo</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_open"><strong><code>open</code></strong></a></p></td>
</tr>
<tr>
+<td align="left" valign="top"><p class="table"><a href="#_open"><strong><code>open</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_1"><strong><code>os.fork</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_1"><strong><code>os.gethostname</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_1"><strong><code>os.getids</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#cmd_1"><strong><code>os.umask</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_1"><strong><code>os.uptime</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_3"><strong><code>pack</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_3"><strong><code>pack</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_package"><strong><code>package</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_pid"><strong><code>pid</code></strong></a></p></td>
</tr>
<tr>
+<td align="left" valign="top"><p class="table"><a href="#_package"><strong><code>package</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_pid"><strong><code>pid</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_pipe"><strong><code>pipe</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_1"><strong><code>posix</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_proc"><strong><code>proc</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_puts"><strong><code>puts</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_pwd"><strong><code>pwd</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_rand"><strong><code>rand</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_range"><strong><code>range</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_read"><strong><code>read</code></strong></a></p></td>
</tr>
<tr>
+<td align="left" valign="top"><p class="table"><a href="#_range"><strong><code>range</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_read"><strong><code>read</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_ref"><strong><code>ref</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_regexp"><strong><code>regexp</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_regsub"><strong><code>regsub</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_rename"><strong><code>rename</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_return"><strong><code>return</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_scan"><strong><code>scan</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_seek"><strong><code>seek</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_set"><strong><code>set</code></strong></a></p></td>
</tr>
<tr>
+<td align="left" valign="top"><p class="table"><a href="#_seek"><strong><code>seek</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_set"><strong><code>set</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_setref"><strong><code>setref</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_signal"><strong><code>signal</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_sleep"><strong><code>sleep</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_socket"><strong><code>socket</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_source"><strong><code>source</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_split"><strong><code>split</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_stackdump"><strong><code>stackdump</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_stacktrace"><strong><code>stacktrace</code></strong></a></p></td>
</tr>
<tr>
+<td align="left" valign="top"><p class="table"><a href="#_stackdump"><strong><code>stackdump</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_stacktrace"><strong><code>stacktrace</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_string"><strong><code>string</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_subst"><strong><code>subst</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_4"><strong><code>super</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_switch"><strong><code>switch</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_syslog"><strong><code>syslog</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_tailcall"><strong><code>tailcall</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_tcl_autocomplete"><strong><code>tcl::autocomplete</code></strong></a></p></td>
-<td align="left" valign="top"><p class="table"><a href="#_tcl_prefix"><strong><code>tcl::prefix</code></strong></a></p></td>
</tr>
<tr>
+<td align="left" valign="top"><p class="table"><a href="#_taint"><strong><code>taint</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_tcl_autocomplete"><strong><code>tcl::autocomplete</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_tcl_prefix"><strong><code>tcl::prefix</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_tcl_stdhint"><strong><code>tcl::stdhint</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_tell"><strong><code>tell</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_throw"><strong><code>throw</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_time"><strong><code>time</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_timerate"><strong><code>timerate</code></strong></a></p></td>
+</tr>
+<tr>
<td align="left" valign="top"><p class="table"><a href="#_tree"><strong><code>tree</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_try"><strong><code>try</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_unknown"><strong><code>unknown</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_3"><strong><code>unpack</code></strong></a></p></td>
-</tr>
-<tr>
<td align="left" valign="top"><p class="table"><a href="#_unset"><strong><code>unset</code></strong></a></p></td>
+<td align="left" valign="top"><p class="table"><a href="#_untaint"><strong><code>untaint</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_upcall"><strong><code>upcall</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_2"><strong><code>update</code></strong></a></p></td>
+</tr>
+<tr>
<td align="left" valign="top"><p class="table"><a href="#_uplevel"><strong><code>uplevel</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_upvar"><strong><code>upvar</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#cmd_2"><strong><code>vwait</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_wait"><strong><code>wait</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_while"><strong><code>while</code></strong></a></p></td>
-</tr>
-<tr>
<td align="left" valign="top"><p class="table"><a href="#_xtrace"><strong><code>xtrace</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"><a href="#_zlib"><strong><code>zlib</code></strong></a></p></td>
<td align="left" valign="top"><p class="table"></p></td>
-<td align="left" valign="top"><p class="table"></p></td>
-<td align="left" valign="top"><p class="table"></p></td>
-<td align="left" valign="top"><p class="table"></p></td>
-<td align="left" valign="top"><p class="table"></p></td>
-<td align="left" valign="top"><p class="table"></p></td>
</tr>
</tbody>
</table>
@@ -3591,10 +3676,23 @@ command. The legal <code><em>options</em></code> (which may be abbreviated) are </div>
<div class="sect2">
<h3 id="_break">break</h3>
-<div class="paragraph"><p><code><strong>break</strong></code></p></div>
+<div class="paragraph"><p><code><strong>break</strong> ?n?</code></p></div>
<div class="paragraph"><p>This command may be invoked only inside the body of a loop command
-such as <a href="#_for"><strong><code>for</code></strong></a> or <a href="#_foreach"><strong><code>foreach</code></strong></a> or <a href="#_while"><strong><code>while</code></strong></a>. It returns a <code>JIM_BREAK</code> code
+such as <a href="#_for"><strong><code>for</code></strong></a>, <a href="#_foreach"><strong><code>foreach</code></strong></a>, <a href="#_while"><strong><code>while</code></strong></a> or <a href="#_loop"><strong><code>loop</code></strong></a>. It returns a <code>JIM_BREAK</code> code
to signal the innermost containing loop command to return immediately.</p></div>
+<div class="paragraph"><p>If <code><em>n</em></code> is given it breaks out of that many loops. <code><em>break 1</em></code> is equivalent
+to a simple <code><em>break</em></code> while in the following example, <code><em>break</em></code> will exit both
+loops.</p></div>
+<div class="listingblock">
+<div class="content">
+<pre><code> loop i 5 {
+ loop j 6 {
+ if {$i == 3 && $j == 2} {
+ break 2
+ }
+ }
+ }</code></pre>
+</div></div>
</div>
<div class="sect2">
<h3 id="_case">case</h3>
@@ -3728,11 +3826,8 @@ compliant.</p></div> <div class="sect2">
<h3 id="_close">close</h3>
<div class="paragraph"><p><code><strong>close</strong> <em>fileId</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>close</strong></code></p></div>
-<div class="paragraph"><p>Closes the file given by <code><em>fileId</em></code>.
-<code><em>fileId</em></code> must be the return value from a previous invocation
-of the <a href="#_open"><strong><code>open</code></strong></a> command; after this command, it should not be
-used anymore.</p></div>
+<div class="paragraph"><p>Tcl-compatible version of <code><em>fileId</em> <strong>close</strong></code></p></div>
+<div class="paragraph"><p>See <a href="#_aio"><strong><code>aio</code></strong></a> <code>close</code></p></div>
</div>
<div class="sect2">
<h3 id="_collect">collect</h3>
@@ -3760,18 +3855,20 @@ the command</p></div> </div>
<div class="sect2">
<h3 id="_continue">continue</h3>
-<div class="paragraph"><p><code><strong>continue</strong></code></p></div>
+<div class="paragraph"><p><code><strong>continue</strong> ?n?</code></p></div>
<div class="paragraph"><p>This command may be invoked only inside the body of a loop command such
-as <a href="#_for"><strong><code>for</code></strong></a> or <a href="#_foreach"><strong><code>foreach</code></strong></a> or <a href="#_while"><strong><code>while</code></strong></a>. It returns a <code>JIM_CONTINUE</code> code to
+as <a href="#_for"><strong><code>for</code></strong></a>, <a href="#_foreach"><strong><code>foreach</code></strong></a>, <a href="#_while"><strong><code>while</code></strong></a> or <a href="#_loop"><strong><code>loop</code></strong></a>. It returns a <code>JIM_CONTINUE</code> code to
signal the innermost containing loop command to skip the remainder of
the loop’s body but continue with the next iteration of the loop.</p></div>
+<div class="paragraph"><p>If <code><em>n</em></code> is given it breaks out of <code><em>n-1</em></code> loops and then continues the <code><em>nth</em></code> loop.
+<code><em>continue 1</em></code> is equivalent to a simple <code><em>continue</em></code>. (See also <a href="#_break"><strong><code>break</code></strong></a>).</p></div>
</div>
<div class="sect2">
<h3 id="_curry">curry</h3>
-<div class="paragraph"><p><code><strong>alias</strong> <em>args...</em></code></p></div>
+<div class="paragraph"><p><code><strong>curry</strong> <em>args...</em></code></p></div>
<div class="paragraph"><p>Similar to <a href="#_alias"><strong><code>alias</code></strong></a> except it creates an anonymous procedure (lambda) instead of
a named procedure.</p></div>
-<div class="paragraph"><p>the following creates a local, unnamed alias for the command <a href="#_info"><strong><code>info</code></strong></a> <code>exists</code>.</p></div>
+<div class="paragraph"><p>The following creates a local, unnamed alias for the command <a href="#_info"><strong><code>info</code></strong></a> <code>exists</code>.</p></div>
<div class="listingblock">
<div class="content">
<pre><code> set e [local curry info exists]
@@ -3805,6 +3902,16 @@ when the proc or interpreter exits.</p></div> command. The legal <code><em>options</em></code> are:</p></div>
<div class="dlist"><dl>
<dt class="hdlist1">
+<code><strong>dict append</strong> <em>dictionaryName key ?string …?</em></code>
+</dt>
+<dd>
+<p>
+ This appends the given string (or strings) to the value that
+ the given key maps to in <code><em>dictionaryName</em></code>. Non-existent keys
+ are treated as if they map to an empty string.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>dict create</strong> <em>?key value ...?</em></code>
</dt>
<dd>
@@ -3827,6 +3934,14 @@ command. The legal <code><em>options</em></code> are:</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>dict for</strong> <em>{keyvar valuevar} dictionary script</em></code>
+</dt>
+<dd>
+<p>
+ <strong>TBD</strong>
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>dict get</strong> <em>dictionary ?key ...?</em></code>
</dt>
<dd>
@@ -3862,6 +3977,27 @@ command. The legal <code><em>options</em></code> are:</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>dict incr</strong> <em>dictionaryName key ?increment?</em></code>
+</dt>
+<dd>
+<p>
+ This adds the given increment value (an integer that defaults
+ to 1 if not specified) to the value that the given key maps to
+ in <code><em>dictionaryName</em></code>. Non-existent keys are treated as if
+ they map to 0. It is an error to increment a value for an
+ existing key if that value is not an integer.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>dict info</strong> <em>dictionary</em></code>
+</dt>
+<dd>
+<p>
+ Returns some information about the utilisation of the data
+ within the hashtable that represents <code><em>dictionary</em></code>.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>dict keys</strong> <em>dictionary ?pattern?</em></code>
</dt>
<dd>
@@ -3873,6 +4009,16 @@ command. The legal <code><em>options</em></code> are:</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>dict lappend</strong> <em>dictionaryName key ?value …?</em></code>
+</dt>
+<dd>
+<p>
+ This appends the given items to the list value that the given
+ key maps to in <code><em>dictionaryName</em></code>. Non-existent keys are treated
+ as if they map to the empty list.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>dict merge</strong> ?<em>dictionary ...</em>?</code>
</dt>
<dd>
@@ -3885,6 +4031,18 @@ command. The legal <code><em>options</em></code> are:</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>dict replace</strong> <em>dictionary ?key value …?</em></code>
+</dt>
+<dd>
+<p>
+ Return a new dictionary that is a copy of <code><em>dictionary</em></code>
+ except with some values different or some
+ extra key/value pairs added. It is legal for this command to
+ be called with no key/value pairs, but illegal for this command
+ to be called with a key but no value.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>dict set</strong> <em>dictionaryName key ?key ...? value</em></code>
</dt>
<dd>
@@ -3919,6 +4077,26 @@ command. The legal <code><em>options</em></code> are:</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>dict update</strong> <em>dictionaryName key varName ?key VarName …? script</em></code>
+</dt>
+<dd>
+<p>
+ <strong>TBD</strong>
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>dict values</strong> <em>dictionary ?globPattern?</em></code>
+</dt>
+<dd>
+<p>
+ Return a list of all values in <code><em>dictionary</em></code>. If a pattern is
+ supplied, only those values that match it (according to the
+ rules of <a href="#_string"><strong><code>string</code></strong></a> <code>match</code>) will be returned. The returned values
+ will be in the order of that the keys associated with those
+ values were inserted into the dictionary.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>dict with</strong> <em>dictionaryName key ?key ...? script</em></code>
</dt>
<dd>
@@ -3949,7 +4127,6 @@ command. The legal <code><em>options</em></code> are:</p></div> </p>
</dd>
</dl></div>
-<div class="paragraph"><p><code><strong>dict for, values, incr, append, lappend, update, info, replace</strong></code> to be documented…</p></div>
</div>
<div class="sect2">
<h3 id="_ensemble">ensemble</h3>
@@ -3957,19 +4134,15 @@ command. The legal <code><em>options</em></code> are:</p></div> <div class="paragraph"><p>Create a single ensemble command that redirects to individual commands based on the prefix.
By default, the prefix is <code><em>name</em></code> followed by a single space.</p></div>
<div class="paragraph"><p>For example, consider:</p></div>
-<div class="literalblock">
+<div class="listingblock">
<div class="content">
-<pre><code>proc {test open} {name} { ... }
-proc {test close} {handle} { ... }
-proc {test show} {handle} { ... }
-ensemble test</code></pre>
+<pre><code> proc {test open} {name} { ... }
+ proc {test close} {handle} { ... }
+ proc {test show} {handle} { ... }
+ ensemble test</code></pre>
</div></div>
<div class="paragraph"><p>Now the <em><code>test</code></em> command has been created that redirects based on the first argument.
-e.g.</p></div>
-<div class="literalblock">
-<div class="content">
-<pre><code>test open $filename => {test open} $filename</code></pre>
-</div></div>
+e.g. <code><em>test open $filename</em></code> ⇒ <code><em>{test open} $filename</em></code></p></div>
</div>
<div class="sect2">
<h3 id="_env">env</h3>
@@ -3985,12 +4158,8 @@ and their values as <code>{name value ...}</code></p></div> <div class="sect2">
<h3 id="_eof">eof</h3>
<div class="paragraph"><p><code><strong>eof</strong> <em>fileId</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>eof</strong></code></p></div>
-<div class="paragraph"><p>Returns 1 if an end-of-file condition has occurred on <code><em>fileId</em></code>,
-0 otherwise.</p></div>
-<div class="paragraph"><p><code><em>fileId</em></code> must have been the return value from a previous call to <a href="#_open"><strong><code>open</code></strong></a>,
-or it may be <code>stdin</code>, <code>stdout</code>, or <code>stderr</code> to refer to one of the
-standard I/O channels.</p></div>
+<div class="paragraph"><p>Tcl-compatible alternative to <code><em>fileId</em> <strong>eof</strong></code></p></div>
+<div class="paragraph"><p>See <a href="#_aio"><strong><code>aio</code></strong></a> <code>eof</code></p></div>
</div>
<div class="sect2">
<h3 id="_error">error</h3>
@@ -4039,6 +4208,7 @@ evaluation (or any error generated by it).</p></div> <div class="sect2">
<h3 id="_exec">exec</h3>
<div class="paragraph"><p><code><strong>exec</strong> <em>arg ?arg...?</em></code></p></div>
+<div class="paragraph"><p><code><strong>exec</strong> | <em>{cmdlist ...} ?redirection ...?</em></code></p></div>
<div class="paragraph"><p>This command treats its arguments as the specification
of one or more UNIX commands to execute as subprocesses.
The commands take the form of a standard shell pipeline;
@@ -4065,7 +4235,8 @@ messages are suppressed.</p></div> is a newline then that character is deleted from the result
or error message for consistency with normal
Tcl return values.</p></div>
-<div class="paragraph"><p>An <code><em>arg</em></code> may have one of the following special forms:</p></div>
+<div class="paragraph"><p>An <code><em>arg</em></code> (or <code><em>redirection</em></code> in the second form) may have one of the
+following special forms:</p></div>
<div class="dlist"><dl>
<dt class="hdlist1">
<code>>filename</code>
@@ -4101,7 +4272,7 @@ Tcl return values.</p></div> </dt>
<dd>
<p>
- The standard error of the last command in the pipeline
+ The standard error of all commands in the pipeline
is redirected to the file.
</p>
</dd>
@@ -4118,7 +4289,7 @@ Tcl return values.</p></div> </dt>
<dd>
<p>
- The standard error of the last command in the pipeline is
+ The standard error of all commands in the pipeline is
redirected to the given (writable) file descriptor.
</p>
</dd>
@@ -4127,8 +4298,8 @@ Tcl return values.</p></div> </dt>
<dd>
<p>
- The standard error of the last command in the pipeline is
- redirected to the same file descriptor as the standard output.
+ The standard error of all commands in the pipeline is
+ redirected command output.
</p>
</dd>
<dt class="hdlist1">
@@ -4136,8 +4307,8 @@ Tcl return values.</p></div> </dt>
<dd>
<p>
- Both the standard output and standard error of the last command
- in the pipeline is redirected to the file.
+ Both standard output from the last command and standard error from all commands
+ in the pipeline are redirected to the file.
</p>
</dd>
<dt class="hdlist1">
@@ -4176,21 +4347,24 @@ Tcl return values.</p></div> </p>
</dd>
</dl></div>
+<div class="paragraph"><p>Note that any of the forms that take an argument (filename, fileId or string)
+their argument may be a separate word. e.g. <code><em><< $str</em></code>.</p></div>
<div class="paragraph"><p>If there is no redirection of standard input, standard error
or standard output, these are connected to the corresponding
input or output of the application.</p></div>
-<div class="paragraph"><p>If the last <code><em>arg</em></code> is <code>&</code> then the command will be
-executed in background.
-In this case the standard output from the last command
-in the pipeline will
-go to the application’s standard output unless
-redirected in the command, and error output from all
-the commands in the pipeline will go to the application’s
-standard error file. The return value of exec in this case
-is a list of process ids (pids) in the pipeline.</p></div>
+<div class="paragraph"><p>If the last <code><em>arg</em></code> or <code><em>redirection</em></code> is <code>&</code> then the command will be
+executed in background. In this case the standard output from the last
+command in the pipeline will go to the application’s standard output
+unless redirected in the command, and error output from all the commands
+in the pipeline will go to the application’s standard error file. The
+return value of exec in this case is a list of process ids (pids) in
+the pipeline.</p></div>
<div class="paragraph"><p>Each <code><em>arg</em></code> becomes one word for a command, except for
<code>|</code>, <code><</code>, <code><<</code>, <code>></code>, and <code>&</code> arguments, and the
arguments that follow <code><</code>, <code><<</code>, and <code>></code>.</p></div>
+<div class="paragraph"><p>In the second form, <code><em>cmdlist</em></code> is the command list, so there
+is no ambiguity about whether an argument or a redirection.
+Note that this second form is not currently supported by Tcl.</p></div>
<div class="paragraph"><p>The first word in each command is taken as the command name;
the directories in the PATH environment variable are searched for
an executable by the given name.</p></div>
@@ -4246,11 +4420,11 @@ this variable is unset, in which case the original environment is used).</p></di </div>
<div class="sect2">
<h3 id="_exists">exists</h3>
-<div class="paragraph"><p><code><strong>exists ?-var|-proc|-command|-alias?</strong> <em>name</em></code></p></div>
-<div class="paragraph"><p>Checks the existence of the given variable, procedure, command
-or alias respectively and returns 1 if it exists or 0 if not. This command
+<div class="paragraph"><p><code><strong>exists ?-var|-proc|-command|-alias|-channel?</strong> <em>name</em></code></p></div>
+<div class="paragraph"><p>Checks the existence of the given variable, procedure, command,
+alias or channel respectively and returns 1 if it exists or 0 if not. This command
provides a more simplified/convenient version of <a href="#_info"><strong><code>info</code></strong></a> <code>exists</code>,
-<a href="#_info"><strong><code>info</code></strong></a> <code>procs</code> and <a href="#_info"><strong><code>info</code></strong></a> <code>commands</code>.</p></div>
+<a href="#_info"><strong><code>info</code></strong></a> <code>procs</code>, <a href="#_info"><strong><code>info</code></strong></a> <code>commands</code>, <a href="#_info"><strong><code>info</code></strong></a> <code>aliases</code> and <a href="#_info"><strong><code>info</code></strong></a> <code>channels</code>.</p></div>
<div class="paragraph"><p>If the type is omitted, a type of <em>-var</em> is used. The type may be abbreviated.</p></div>
</div>
<div class="sect2">
@@ -4274,6 +4448,21 @@ The following two are identical.</p></div> <pre><code> set x [expr {3 * 2 + 1}]
set x $(3 * 2 + 1)</code></pre>
</div></div>
+<div class="paragraph"><p>However, note that the expr shorthand syntax may not be nested in an expression.
+This is to prevent the common mistake of writing:</p></div>
+<div class="listingblock">
+<div class="content">
+<pre><code> if {$(1 + 2) == 3} {
+ ...
+ }</code></pre>
+</div></div>
+<div class="paragraph"><p>rather than:</p></div>
+<div class="listingblock">
+<div class="content">
+<pre><code> if {(1 + 2) == 3} {
+ ...
+ }</code></pre>
+</div></div>
</div>
<div class="sect2">
<h3 id="_file">file</h3>
@@ -4602,12 +4791,8 @@ command.</p></div> <div class="sect2">
<h3 id="_flush">flush</h3>
<div class="paragraph"><p><code><strong>flush</strong> <em>fileId</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>flush</strong></code></p></div>
-<div class="paragraph"><p>Flushes any output that has been buffered for <code><em>fileId</em></code>. <code><em>fileId</em></code> must
-have been the return value from a previous call to <a href="#_open"><strong><code>open</code></strong></a>, or it may be
-<code>stdout</code> or <code>stderr</code> to access one of the standard I/O streams; it must
-refer to a file that was opened for writing. This command returns an
-empty string.</p></div>
+<div class="paragraph"><p>Tcl-compatible alternative to <code><em>fileId</em> <strong>flush</strong></code></p></div>
+<div class="paragraph"><p>See <a href="#_aio"><strong><code>aio</code></strong></a> <code>flush</code></p></div>
</div>
<div class="sect2">
<h3 id="_for">for</h3>
@@ -4684,27 +4869,8 @@ be a valid reference create with the <a href="#_ref"><strong><code>ref</code></s <div class="sect2">
<h3 id="_gets">gets</h3>
<div class="paragraph"><p><code><strong>gets</strong> <em>fileId ?varName?</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>gets</strong> <em>?varName?</em></code></p></div>
-<div class="paragraph"><p>Reads the next line from the file given by <code><em>fileId</em></code> and discards
-the terminating newline character.</p></div>
-<div class="paragraph"><p>If <code><em>varName</em></code> is specified, then the line is placed in the variable
-by that name and the return value is a count of the number of characters
-read (not including the newline).</p></div>
-<div class="paragraph"><p>If the end of the file is reached before reading
-any characters then -1 is returned and <code><em>varName</em></code> is set to an
-empty string.</p></div>
-<div class="paragraph"><p>If <code><em>varName</em></code> is not specified then the return value will be
-the line (minus the newline character) or an empty string if
-the end of the file is reached before reading any characters.</p></div>
-<div class="paragraph"><p>An empty string will also be returned if a line contains no characters
-except the newline, so <a href="#_eof"><strong><code>eof</code></strong></a> may have to be used to determine
-what really happened.</p></div>
-<div class="paragraph"><p>If the last character in the file is not a newline character, then
-<a href="#_gets"><strong><code>gets</code></strong></a> behaves as if there were an additional newline character
-at the end of the file.</p></div>
-<div class="paragraph"><p><code><em>fileId</em></code> must be <code>stdin</code> or the return value from a previous
-call to <a href="#_open"><strong><code>open</code></strong></a>; it must refer to a file that was opened
-for reading.</p></div>
+<div class="paragraph"><p>Tcl-compatible alterative version of <code><em>fileId</em> <strong>gets</strong> <em>?varName?</em></code></p></div>
+<div class="paragraph"><p>See <a href="#_aio"><strong><code>aio</code></strong></a> <code>gets</code></p></div>
</div>
<div class="sect2">
<h3 id="_glob">glob</h3>
@@ -4797,6 +4963,15 @@ The legal <code><em>option</em></code>'s (which may be abbreviated) are: </p>
</dd>
<dt class="hdlist1">
+<code><strong>info aliases ?-all?</strong> ?<em>pattern</em>?</code>
+</dt>
+<dd>
+<p>
+ Returns a list of alias commands.
+ See <a href="#_info"><strong><code>info</code></strong></a> <code>commands</code> for the meaning of <code><strong>-all</strong></code> and <code><em>pattern</em></code>.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>info body</strong> <em>procname</em></code>
</dt>
<dd>
@@ -4806,23 +4981,27 @@ The legal <code><em>option</em></code>'s (which may be abbreviated) are: </p>
</dd>
<dt class="hdlist1">
-<code><strong>info channels</strong></code>
+<code><strong>info channels ?-all?</strong> ?<em>pattern</em>?</code>
</dt>
<dd>
<p>
- Returns a list of all open file handles from <a href="#_open"><strong><code>open</code></strong></a> or <a href="#_socket"><strong><code>socket</code></strong></a>
+ Returns a list of open file handles from <a href="#_open"><strong><code>open</code></strong></a> or <a href="#_socket"><strong><code>socket</code></strong></a>.
+ See <a href="#_info"><strong><code>info</code></strong></a> <code>commands</code> for the meaning of <code><strong>-all</strong></code> and <code><em>pattern</em></code>.
</p>
</dd>
<dt class="hdlist1">
-<code><strong>info commands</strong> ?<em>pattern</em>?</code>
+<code><strong>info commands ?-all?</strong> ?<em>pattern</em>?</code>
</dt>
<dd>
<p>
If <code><em>pattern</em></code> isn’t specified, returns a list of names of all the
Tcl commands, including both the built-in commands written in C and
- the command procedures defined using the <a href="#_proc"><strong><code>proc</code></strong></a> command.
+ the command procedures defined using the <a href="#_proc"><strong><code>proc</code></strong></a> command (including aliases
+ and channels).
If <code><em>pattern</em></code> is specified, only those names matching <code><em>pattern</em></code>
(using <a href="#_string_matching">STRING MATCHING</a> rules) are returned.
+ Normally commands containing a space character are not returned.
+ If <code><strong>-all</strong></code> is given, the result does include these commands.
</p>
</dd>
<dt class="hdlist1">
@@ -4988,14 +5167,21 @@ The legal <code><em>option</em></code>'s (which may be abbreviated) are: </p>
</dd>
<dt class="hdlist1">
-<code><strong>info procs</strong> ?<em>pattern</em>?</code>
+<code><strong>info patchlevel</strong></code>
</dt>
<dd>
<p>
- If <code><em>pattern</em></code> isn’t specified, returns a list of all the
- names of Tcl command procedures.
- If <code><em>pattern</em></code> is specified, only those names matching <code><em>pattern</em></code>
- (using <a href="#_string_matching">STRING MATCHING</a> rules) are returned.
+ Returns the build (git) version if available. Otherwise
+ returns the same as <a href="#_info"><strong><code>info</code></strong></a> <code>version</code>.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>info procs ?-all?</strong> ?<em>pattern</em>?</code>
+</dt>
+<dd>
+<p>
+ Returns a list containing the names of Tcl command procedures.
+ See <a href="#_info"><strong><code>info</code></strong></a> <code>commands</code> for the meaning of <code><strong>-all</strong></code> and <code><em>pattern</em></code>.
</p>
</dd>
<dt class="hdlist1">
@@ -5047,7 +5233,7 @@ The legal <code><em>option</em></code>'s (which may be abbreviated) are: <dd>
<p>
After an error is caught with <a href="#_catch"><strong><code>catch</code></strong></a>, returns the stack trace as a list
- of <code>{procedure filename line ...}</code>.
+ of <code>{procedure filename line cmd ...}</code>.
</p>
</dd>
<dt class="hdlist1">
@@ -5062,6 +5248,24 @@ The legal <code><em>option</em></code>'s (which may be abbreviated) are: </p>
</dd>
<dt class="hdlist1">
+<code><strong>info tainted</strong> <em>str</em></code>
+</dt>
+<dd>
+<p>
+ Returns 1 if the value is tainted, or 0 if not.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>info usage</strong> <em>command</em></code>
+</dt>
+<dd>
+<p>
+ Returns the usage for the given command. For Tcl command procedures, this is based
+ on the arguments defined for the procedure. For a C command, this is the command usage
+ that was specificied when the command was registered.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>info version</strong></code>
</dt>
<dd>
@@ -5173,6 +5377,51 @@ than variables, a list of unassigned elements is returned.</p></div> </div></div>
</div>
<div class="sect2">
+<h3 id="_lsubst">lsubst</h3>
+<div class="paragraph"><p><code><strong>lsubst ?-line?</strong> <em>string</em></code></p></div>
+<div class="paragraph"><p>This command is similar to <a href="#_list"><strong><code>list</code></strong></a> in that it creates a list, but uses
+the same rules as scripts when constructing the elements of the list.
+It is somewhat similar to <a href="#_subst"><strong><code>subst</code></strong></a> except it produces a list instead of a string.</p></div>
+<div class="paragraph"><p>This means that variables are substituted, commands are evaluated, backslashes are
+interpreted, the expansion operator is applied and comments are skipped.</p></div>
+<div class="paragraph"><p>Consider the following example.</p></div>
+<div class="paragraph"><p>---
+ set x 1
+ set y {2 3}
+ set z 3
+ lsubst {
+ # This is a list with interpolation
+ $x; # The x variable
+ {<strong>}$y; # The y variable expanded
+ [string cat a b c]; # A command
+ {</strong>}[list 4 5]; # A list expanded into multiple elements
+ "$z$z"; # A string with interpolation
+ }
+---</p></div>
+<div class="paragraph"><p>The result of <a href="#_lsubst"><strong><code>lsubst</code></strong></a> is the following list with 7 elements.</p></div>
+<div class="paragraph"><p>---
+ 1 2 3 abc 4 5 33
+---</p></div>
+<div class="paragraph"><p>This is particularly useful when constructing a list (or dict)
+as a data structure as it easily allows for comments and variable and command
+substitution.</p></div>
+<div class="paragraph"><p>Sometimes it is useful to return each "command" as a separate list rather than
+simply running all the words together. This can be accomplished with <a href="#_lsubst"><strong><code>lsubst</code></strong></a> <code>-line</code>.</p></div>
+<div class="paragraph"><p>Consider the following example.</p></div>
+<div class="paragraph"><p>---
+ lsubst -line {
+ # two "lines" because of the semicolon
+ one a; two b
+ # one line with three elements
+ {*}{a b c}
+ }
+---</p></div>
+<div class="paragraph"><p>The result of <a href="#_lsubst"><strong><code>lsubst</code></strong></a> <code>-line</code> is the following list with 3 elements, one for each "command".</p></div>
+<div class="paragraph"><p>---
+{one a} {two b} {a b c}
+---</p></div>
+</div>
+<div class="sect2">
<h3 id="_local">local</h3>
<div class="paragraph"><p><code><strong>local</strong> <em>cmd ?arg...?</em></code></p></div>
<div class="paragraph"><p>First, <a href="#_local"><strong><code>local</code></strong></a> evaluates <code><em>cmd</em></code> with the given arguments. The return value must
@@ -5199,16 +5448,13 @@ continues to have global scope while it is active.</p></div> }</code></pre>
</div></div>
<div class="paragraph"><p>In this example, the lambda is deleted at the end of the procedure rather
-than waiting until garbage collection.</p></div>
+than waiting until garbage collection. Note that <a href="#_local"><strong><code>local</code></strong></a> returns the command name.</p></div>
<div class="listingblock">
<div class="content">
<pre><code> proc outer {} {
- set x [lambda inner {args} {
+ set x [local lambda {args} {
# will be deleted when 'outer' exits
}]
- # Use 'function' here which simply returns $x
- local function $x
-
$x ...
...
}</code></pre>
@@ -5554,31 +5800,52 @@ the list are to be matched against pattern and must have one of the values below <div class="paragraph"><p><code><strong>lsort</strong> <em>?options? list</em></code></p></div>
<div class="paragraph"><p>Sort the elements of <code><em>list</em></code>, returning a new list in sorted order.
By default, ASCII (or UTF-8) sorting is used, with the result in increasing order.</p></div>
-<div class="paragraph"><p>Note that only one sort type may be selected with <code>-integer</code>, <code>-real</code>, <code>-nocase</code> or <code>-command</code>
+<div class="paragraph"><p>Note that only one sort type may be selected with <code>-ascii</code>, <code>-dict</code>, <code>-integer</code>, <code>-real</code>, <code>-nocase</code> or <code>-command</code>
with last option being used.</p></div>
<div class="dlist"><dl>
<dt class="hdlist1">
-<code><strong>-integer</strong></code>
+<code><strong>-ascii</strong></code>
</dt>
<dd>
<p>
- Sort using numeric (integer) comparison.
+ Sort using string comparison. This is the default.
</p>
</dd>
<dt class="hdlist1">
-<code><strong>-real</strong></code>
+<code><strong>-nocase</strong></code>
</dt>
<dd>
<p>
- Sort using floating point comparison.
+ Sort using using string comparison without regard for case.
</p>
</dd>
<dt class="hdlist1">
-<code><strong>-nocase</strong></code>
+<code><strong>-dict</strong></code>
</dt>
<dd>
<p>
Sort using using string comparison without regard for case.
+ Use dictionary-style comparison. This is the same as <em>-ascii</em>
+ except (a) case is ignored except as a tie-breaker and (b) if
+ two strings contain embedded numbers, the numbers compare as
+ integers, not characters. For example, in -dictionary mode,
+ x10y sorts between x9y and x11y.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>-integer</strong></code>
+</dt>
+<dd>
+<p>
+ Sort using numeric (integer) comparison.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>-real</strong></code>
+</dt>
+<dd>
+<p>
+ Sort using floating point comparison.
</p>
</dd>
<dt class="hdlist1">
@@ -5659,12 +5926,14 @@ with last option being used.</p></div> </div>
<div class="sect2">
<h3 id="_open">open</h3>
-<div class="paragraph"><p><code><strong>open</strong> <em>fileName ?access?</em></code></p></div>
+<div class="paragraph"><p><code><strong>open</strong> <em>fileName <strong>?-noclose?</strong> ?access?</em></code></p></div>
<div class="paragraph"><p><code><strong>open</strong> <em>|command-pipeline ?access?</em></code></p></div>
<div class="paragraph"><p>Opens a file and returns an identifier
that may be used in future invocations
of commands like <a href="#_read"><strong><code>read</code></strong></a>, <a href="#_puts"><strong><code>puts</code></strong></a>, and <a href="#_close"><strong><code>close</code></strong></a>.
<code><em>fileName</em></code> gives the name of the file to open.</p></div>
+<div class="paragraph"><p>If <code><em>-noclose</em></code> is given, the returned handle is not automatically
+closed for child proceses.</p></div>
<div class="paragraph"><p>The <code><em>access</em></code> argument indicates the way in which the file is to be accessed.
It may have any of the following values:</p></div>
<div class="dlist"><dl>
@@ -5818,30 +6087,89 @@ pipeline is directed to the current standard output unless overridden by the command. If read-only access is used (e.g. <code><em>access</em></code> is r),
standard input for the pipeline is taken from the current standard
input unless overridden by the command.</p></div>
+<div class="paragraph"><p>Note that this incudes new style exec syntax, e.g. <code><em>open |[list | ls -l] r</em></code>.</p></div>
<div class="paragraph"><p>The <a href="#_pid"><strong><code>pid</code></strong></a> command may be used to return the process ids of the commands
forming the command pipeline.</p></div>
<div class="paragraph"><p>See also <a href="#_socket"><strong><code>socket</code></strong></a>, <a href="#_pid"><strong><code>pid</code></strong></a>, <a href="#_exec"><strong><code>exec</code></strong></a></p></div>
</div>
<div class="sect2">
<h3 id="_package">package</h3>
-<div class="paragraph"><p><code><strong>package provide</strong> <em>name ?version?</em></code></p></div>
-<div class="paragraph"><p>Indicates that the current script provides the package named <code><em>name</em></code>.
+<div class="dlist"><dl>
+<dt class="hdlist1">
+<code><strong>package forget</strong> <em>?name …?</em></code>
+</dt>
+<dd>
+<p>
+Removes the knowledge that the given packages were loaded. This allows new, replacement
+packages to be loaded. Note that it does not remove any effects of the previous packages
+being loaded.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>package provide</strong> <em>name ?version?</em></code>
+</dt>
+<dd>
+<p>
+Indicates that the current script provides the package named <code><em>name</em></code>.
<strong>Note</strong>: The supplied version is ignored. All packages are registered as version 1.0
-(it is simply accepted for compatibility purposes).</p></div>
-<div class="paragraph"><p>Any script that provides a package may include this statement
-as the first statement, although it is not required.</p></div>
-<div class="paragraph"><p><code><strong>package require</strong> <em>name ?version?</em></code></p></div>
-<div class="paragraph"><p>Searches for the package with the given <code><em>name</em></code> by examining each path
+(it is simply accepted for compatibility purposes).
+</p>
+</dd>
+<dt class="hdlist1">
+
+</dt>
+<dd>
+<p>
+Any script that provides a package may include this statement
+as the first statement, although it is not required.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>package require</strong> <em>name ?version?</em></code>
+</dt>
+<dd>
+<p>
+Searches for the package with the given <code><em>name</em></code> by examining each path
in <em>$::auto_path</em> and trying to load <em>$path/$name.so</em> as a dynamic extension,
-or <em>$path/$name.tcl</em> as a script package.</p></div>
-<div class="paragraph"><p>The first such file which is found is considered to provide the package.
-(The version number is ignored).</p></div>
-<div class="paragraph"><p>If <em>$name.so</em> exists, it is loaded with the <a href="#_load"><strong><code>load</code></strong></a> command,
-otherwise if <em>$name.tcl</em> exists it is loaded with the <a href="#_source"><strong><code>source</code></strong></a> command.</p></div>
-<div class="paragraph"><p>If <a href="#_load"><strong><code>load</code></strong></a> or <a href="#_source"><strong><code>source</code></strong></a> fails, <a href="#_package"><strong><code>package</code></strong></a> <code>require</code> will fail immediately.
-No further attempt will be made to locate the file.</p></div>
-<div class="paragraph"><p><code><strong>package names</strong></code></p></div>
-<div class="paragraph"><p>Returns a list of all known/loaded packages, including internal packages.</p></div>
+or <em>$path/$name.tcl</em> as a script package.
+</p>
+</dd>
+<dt class="hdlist1">
+
+</dt>
+<dd>
+<p>
+The first such file which is found is considered to provide the package.
+(The version number is ignored).
+</p>
+</dd>
+<dt class="hdlist1">
+
+</dt>
+<dd>
+<p>
+If <em>$name.so</em> exists, it is loaded with the <a href="#_load"><strong><code>load</code></strong></a> command,
+otherwise if <em>$name.tcl</em> exists it is loaded with the <a href="#_source"><strong><code>source</code></strong></a> command.
+</p>
+</dd>
+<dt class="hdlist1">
+
+</dt>
+<dd>
+<p>
+If <a href="#_load"><strong><code>load</code></strong></a> or <a href="#_source"><strong><code>source</code></strong></a> fails, <a href="#_package"><strong><code>package</code></strong></a> <code>require</code> will fail immediately.
+No further attempt will be made to locate the file.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>package names</strong></code>
+</dt>
+<dd>
+<p>
+Returns a list of all known/loaded packages, including internal packages.
+</p>
+</dd>
+</dl></div>
</div>
<div class="sect2">
<h3 id="_pid">pid</h3>
@@ -5874,19 +6202,8 @@ procedure-as-a-whole will return that same error.</p></div> <div class="sect2">
<h3 id="_puts">puts</h3>
<div class="paragraph"><p><code><strong>puts</strong> ?<strong>-nonewline</strong>? <em>?fileId? string</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>puts</strong> ?<strong>-nonewline</strong>? <em>string</em></code></p></div>
-<div class="paragraph"><p>Writes the characters given by <code><em>string</em></code> to the file given
-by <code><em>fileId</em></code>. <code><em>fileId</em></code> must have been the return
-value from a previous call to <a href="#_open"><strong><code>open</code></strong></a>, or it may be
-<code>stdout</code> or <code>stderr</code> to refer to one of the standard I/O
-channels; it must refer to a file that was opened for
-writing.</p></div>
-<div class="paragraph"><p>In the first form, if no <code><em>fileId</em></code> is specified then it defaults to <code>stdout</code>.
-<a href="#_puts"><strong><code>puts</code></strong></a> normally outputs a newline character after <code><em>string</em></code>,
-but this feature may be suppressed by specifying the <code>-nonewline</code>
-switch.</p></div>
-<div class="paragraph"><p>Output to files is buffered internally by Tcl; the <a href="#_flush"><strong><code>flush</code></strong></a>
-command may be used to force buffered characters to be output.</p></div>
+<div class="paragraph"><p>Tcl-compatible version of <code><em>fileId</em> <strong>puts</strong> ?<strong>-nonewline</strong>? <em>string</em></code></p></div>
+<div class="paragraph"><p>See <a href="#_aio"><strong><code>aio</code></strong></a> <code>puts</code></p></div>
</div>
<div class="sect2">
<h3 id="_pipe">pipe</h3>
@@ -5901,6 +6218,7 @@ command may be used to force buffered characters to be output.</p></div> $r readable ...</code></pre>
</div></div>
+<div class="paragraph"><p>Note that if <em><code>-noclose</code></em> is desired, use <a href="#_socket"><strong><code>socket</code></strong></a> <code>-noclose pipe</code> instead.</p></div>
</div>
<div class="sect2">
<h3 id="_pwd">pwd</h3>
@@ -5934,39 +6252,13 @@ and ranging up to but not including <code><em>end</em></code> in steps of <code> </div>
<div class="sect2">
<h3 id="_read">read</h3>
-<div class="paragraph"><p><code><strong>read</strong> ?<strong>-nonewline</strong>? <em>fileId</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>read</strong> ?<strong>-nonewline</strong>?</code></p></div>
-<div class="paragraph"><p><code><strong>read</strong> <em>fileId numBytes</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>read</strong> <em>numBytes</em></code></p></div>
-<div class="paragraph"><p><code><strong>read</strong> ?<strong>-pending</strong>? <em>fileId</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>read</strong> ?<strong>-pending</strong>?</code></p></div>
-<div class="paragraph"><p>In the first form, all of the remaining bytes are read from the file
-given by <code><em>fileId</em></code>; they are returned as the result of the command.
-If the <code>-nonewline</code> switch is specified then the last
-character of the file is discarded if it is a newline.</p></div>
-<div class="paragraph"><p>In the second form, the extra argument specifies how many bytes to read;
-exactly this many bytes will be read and returned, unless there are fewer than
-<code><em>numBytes</em></code> bytes left in the file; in this case, all the remaining
-bytes are returned.</p></div>
-<div class="paragraph"><p>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.</p></div>
-<div class="listingblock">
-<div class="content">
-<pre><code> $sock readable {
- set buf [$sock read -pending]
- }</code></pre>
-</div></div>
-<div class="paragraph"><p>This is necessary because otherwise pending data may be buffered, but
-the underlying socket will not be marked <em>readable</em>. This featured is not
-currently supported for regular sockets, and so these sockets must be
-set to unbufferred (<code>$sock buffering false</code>) to work in an event loop.</p></div>
-<div class="paragraph"><p><code><em>fileId</em></code> must be <code>stdin</code> or the return value from a previous call
-to <a href="#_open"><strong><code>open</code></strong></a>; it must refer to a file that was opened for reading.</p></div>
+<div class="paragraph"><p><code><strong>read</strong> ?-nonewline? <em>fileId ?length?</em></code></p></div>
+<div class="paragraph"><p>Tcl-compatible alterative version of <code><em>fileId</em> <strong>read ?-nonewline?</strong> <em>?length?</em></code></p></div>
+<div class="paragraph"><p>See <a href="#_aio"><strong><code>aio</code></strong></a> <code>read</code></p></div>
</div>
<div class="sect2">
<h3 id="_regexp">regexp</h3>
-<div class="paragraph"><p><code><strong>regexp ?-nocase? ?-line? ?-indices? ?-start</strong> <em>offset</em>? <strong>?-all? ?-inline? ?--?</strong> <em>exp string ?matchVar? ?subMatchVar subMatchVar ...?</em></code></p></div>
+<div class="paragraph"><p><code><strong>regexp ?-nocase? ?-line? ?-indices? ?-start</strong> <em>offset</em>? <strong>?-all? ?-inline? ?-expanded? ?--?</strong> <em>exp string ?matchVar? ?subMatchVar subMatchVar ...?</em></code></p></div>
<div class="paragraph"><p>Determines whether the regular expression <code><em>exp</em></code> matches part or
all of <code><em>string</em></code> and returns 1 if it does, 0 if it doesn’t.</p></div>
<div class="paragraph"><p>See <a href="#_regular_expressions">REGULAR EXPRESSIONS</a> above for complete information on the
@@ -6064,6 +6356,15 @@ string otherwise.</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>-expanded</strong></code>
+</dt>
+<dd>
+<p>
+ Enables use of the expanded regular expression syntax where whitespace
+ and comments are ignored.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>--</strong></code>
</dt>
<dd>
@@ -6076,7 +6377,7 @@ string otherwise.</p></div> </div>
<div class="sect2">
<h3 id="_regsub">regsub</h3>
-<div class="paragraph"><p><code><strong>regsub ?-nocase? ?-all? ?-line? ?-start</strong> <em>offset</em>? ?<strong>--</strong>? <em>exp string subSpec ?varName?</em></code></p></div>
+<div class="paragraph"><p><code><strong>regsub ?-nocase? ?-all? ?-line? ?-command? ?-expanded? ?-start</strong> <em>offset</em>? ?<strong>--</strong>? <em>exp string subSpec ?varName?</em></code></p></div>
<div class="paragraph"><p>This command matches the regular expression <code><em>exp</em></code> against
<code><em>string</em></code> using the rules described in REGULAR EXPRESSIONS
above.</p></div>
@@ -6142,6 +6443,36 @@ backslashes.</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>-command</strong></code>
+</dt>
+<dd>
+<p>
+ Changes the handling of <code><em>subSpec</em></code> so that it is not treated
+ as a template for a substitution string and the substrings <code><strong>&</strong></code>
+ and <code><strong>\n</strong></code> no longer have special meaning. Instead <code><em>subSpec</em></code> must
+ be a command prefix, that is, a non-empty list. The substring
+ of string that matches <code><em>exp</em></code>, and then each substring that matches
+ each capturing sub-RE within <code><em>exp</em></code>, are appended as additional
+ elements to that list. (The items appended to the list are much
+ like what <a href="#_regexp"><strong><code>regexp</code></strong></a> <code>-inline</code> would return). The completed list is
+ then evaluated as a Tcl command, and the result of that command
+ is the substitution string. Any error or exception from command
+ evaluation becomes an error or exception from the regsub command.
+</p>
+</dd>
+<dt class="hdlist1">
+
+</dt>
+<dd>
+<p>
+ If <code><strong>-all</strong></code> is not also given, the command callback will be invoked
+ at most once (exactly when the regular expression matches). If
+ <code><strong>-all</strong></code> is given, the command callback will be invoked for each
+ matched location, in sequence. The exact location indices that
+ matched are not made available to the script.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>-start</strong> <em>offset</em></code>
</dt>
<dd>
@@ -6152,6 +6483,15 @@ backslashes.</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>-expanded</strong></code>
+</dt>
+<dd>
+<p>
+ Enables use of the expanded regular expression syntax where whitespace
+ and comments are ignored.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>--</strong></code>
</dt>
<dd>
@@ -6221,49 +6561,8 @@ specified for this conversion.</p></div> <div class="sect2">
<h3 id="_seek">seek</h3>
<div class="paragraph"><p><code><strong>seek</strong> <em>fileId offset ?origin?</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>seek</strong> <em>offset ?origin?</em></code></p></div>
-<div class="paragraph"><p>Change the current access position for <code><em>fileId</em></code>.
-The <code><em>offset</em></code> and <code><em>origin</em></code> arguments specify the position at
-which the next read or write will occur for <code><em>fileId</em></code>.
-<code><em>offset</em></code> must be a number (which may be negative) and <code><em>origin</em></code>
-must be one of the following:</p></div>
-<div class="dlist"><dl>
-<dt class="hdlist1">
-<code><strong>start</strong></code>
-</dt>
-<dd>
-<p>
- The new access position will be <code><em>offset</em></code> bytes from the start
- of the file.
-</p>
-</dd>
-<dt class="hdlist1">
-<code><strong>current</strong></code>
-</dt>
-<dd>
-<p>
- The new access position will be <code><em>offset</em></code> bytes from the current
- access position; a negative <code><em>offset</em></code> moves the access position
- backwards in the file.
-</p>
-</dd>
-<dt class="hdlist1">
-<code><strong>end</strong></code>
-</dt>
-<dd>
-<p>
- The new access position will be <code><em>offset</em></code> bytes from the end of
- the file. A negative <code><em>offset</em></code> places the access position before
- the end-of-file, and a positive <code><em>offset</em></code> places the access position
- after the end-of-file.
-</p>
-</dd>
-</dl></div>
-<div class="paragraph"><p>The <code><em>origin</em></code> argument defaults to <code>start</code>.</p></div>
-<div class="paragraph"><p><code><em>fileId</em></code> must have been the return value from a previous call to
-<a href="#_open"><strong><code>open</code></strong></a>, or it may be <code>stdin</code>, <code>stdout</code>, or <code>stderr</code> to refer to one
-of the standard I/O channels.</p></div>
-<div class="paragraph"><p>This command returns an empty string.</p></div>
+<div class="paragraph"><p>Tcl-compatible version of <code><em>fileId</em> <strong>seek</strong> <em>offset ?origin?</em></code></p></div>
+<div class="paragraph"><p>See <a href="#_aio"><strong><code>aio</code></strong></a> <code>seek</code></p></div>
</div>
<div class="sect2">
<h3 id="_set">set</h3>
@@ -6460,8 +6759,8 @@ For example,</p></div> <div class="sect2">
<h3 id="_stacktrace">stacktrace</h3>
<div class="paragraph"><p><code><strong>stacktrace</strong></code></p></div>
-<div class="paragraph"><p>Returns a live stack trace as a list of <code>proc file line proc file line ...</code>.
-Iteratively uses <a href="#_info"><strong><code>info</code></strong></a> <code>frame</code> to create the stack trace. This stack trace is in the
+<div class="paragraph"><p>Returns a live stack trace as a list of <code>proc file line cmd proc file line cmd ...</code>.
+uses the same information as <a href="#_info"><strong><code>info</code></strong></a> <code>frame</code> to create the stack trace. This stack trace is in the
same form as produced by <a href="#_catch"><strong><code>catch</code></strong></a> and <a href="#_info"><strong><code>info</code></strong></a> <code>stacktrace</code></p></div>
<div class="paragraph"><p>See also <a href="#_stackdump"><strong><code>stackdump</code></strong></a>.</p></div>
</div>
@@ -7100,14 +7399,15 @@ the current call frame. This is similar to <em>exec</em> in Bourne Shell.</p></d </div></div>
</div>
<div class="sect2">
+<h3 id="_taint">taint</h3>
+<div class="paragraph"><p><code><strong>taint</strong> <em>varname</em></code></p></div>
+<div class="paragraph"><p>Set "taint" on the value contained in the given variable.</p></div>
+</div>
+<div class="sect2">
<h3 id="_tell">tell</h3>
<div class="paragraph"><p><code><strong>tell</strong> <em>fileId</em></code></p></div>
-<div class="paragraph"><p><code><em>fileId</em> <strong>tell</strong></code></p></div>
-<div class="paragraph"><p>Returns a decimal string giving the current access position in
-<code><em>fileId</em></code>.</p></div>
-<div class="paragraph"><p><code><em>fileId</em></code> must have been the return value from a previous call to
-<a href="#_open"><strong><code>open</code></strong></a>, or it may be <code>stdin</code>, <code>stdout</code>, or <code>stderr</code> to refer to one
-of the standard I/O channels.</p></div>
+<div class="paragraph"><p>Tcl-compatible version of <code><em>fileId</em> <strong>tell</strong></code></p></div>
+<div class="paragraph"><p>See <a href="#_aio"><strong><code>aio</code></strong></a> <code>tell</code></p></div>
</div>
<div class="sect2">
<h3 id="_throw">throw</h3>
@@ -7254,6 +7554,11 @@ is specified. The <em>--</em> argument may be specified to stop option processin in case the variable name may be <em>-nocomplain</em>.</p></div>
</div>
<div class="sect2">
+<h3 id="_untaint">untaint</h3>
+<div class="paragraph"><p><code><strong>untaint</strong> <em>varname</em></code></p></div>
+<div class="paragraph"><p>Remove "taint" from the value contained in the given variable.</p></div>
+</div>
+<div class="sect2">
<h3 id="_upcall">upcall</h3>
<div class="paragraph"><p><code><strong>upcall</strong> <em>command ?args …?</em></code></p></div>
<div class="paragraph"><p>May be used from within a proc defined as <a href="#_local"><strong><code>local</code></strong></a> <a href="#_proc"><strong><code>proc</code></strong></a> in order to call
@@ -7400,7 +7705,7 @@ the execution trace is removed.</p></div> <div class="paragraph"><p>The following extensions may or may not be available depending upon
what options were selected when Jim Tcl was built.</p></div>
<div class="sect2">
-<h3 id="cmd_1">posix: os.fork, os.gethostname, os.getids, os.uptime</h3>
+<h3 id="cmd_1">posix: os.fork, os.gethostname, os.getids, os.uptime, os.umask</h3>
<div class="dlist"><dl>
<dt class="hdlist1">
<code><strong>os.fork</strong></code>
@@ -7434,6 +7739,14 @@ what options were selected when Jim Tcl was built.</p></div> </div></div>
<div class="dlist"><dl>
<dt class="hdlist1">
+<code><strong>os.umask</strong> ?newmask?</code>
+</dt>
+<dd>
+<p>
+ Set or return the current process <em>umask(2)</em>. Returns the previous umask.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>os.uptime</strong></code>
</dt>
<dd>
@@ -7448,32 +7761,73 @@ what options were selected when Jim Tcl was built.</p></div> <div class="sect1">
<h2 id="_ansi_i_o_aio_and_eventloop_api">ANSI I/O (aio) and EVENTLOOP API</h2>
<div class="sectionbody">
-<div class="paragraph"><p>Jim provides an alternative object-based API for I/O.</p></div>
-<div class="paragraph"><p>See <a href="#_open"><strong><code>open</code></strong></a> and <a href="#_socket"><strong><code>socket</code></strong></a> for commands which return an I/O handle.</p></div>
+<div class="paragraph"><p>In addition to the traditional Tcl I/O commands (<a href="#_gets"><strong><code>gets</code></strong></a>, <a href="#_read"><strong><code>read</code></strong></a>, <a href="#_puts"><strong><code>puts</code></strong></a>, <a href="#_close"><strong><code>close</code></strong></a>, <a href="#_seek"><strong><code>seek</code></strong></a>, <a href="#_tell"><strong><code>tell</code></strong></a>),
+Jim provides an alternative object-based API for I/O. Commands that create a channel, <a href="#_open"><strong><code>open</code></strong></a> and <a href="#_socket"><strong><code>socket</code></strong></a>,
+return a handle to an I/O channel that is used to control that channel.</p></div>
+<div class="paragraph"><p>For example, the traditional Tcl usage would be:</p></div>
+<div class="listingblock">
+<div class="content">
+<pre><code> set f [open file.txt]
+ while {[gets $f buf] >= 0} {
+ puts stderr $buf
+ }
+ close $f</code></pre>
+</div></div>
+<div class="paragraph"><p>While the Jim usage would be:</p></div>
+<div class="listingblock">
+<div class="content">
+<pre><code> set f [open file.txt]
+ while {[$f gets buf] >= 0} {
+ stderr puts $buf
+ }
+ $f close</code></pre>
+</div></div>
+<div class="paragraph"><p>Thus channels are commands that support the various subcommands. They can be renamed handled
+like any other command. In additional to file I/O and stream (TCP) sockets, Jim supports many
+kinds of socket streams including UDP, Unix domain sockets, psuedo-tty pairs, pipes and others.
+(See <a href="#_socket"><strong><code>socket</code></strong></a> for more detail). The TLS (SSL) protocol may also be seamlessly layered over a channel
+with the <code>ssl</code> command. In addition Jim I/O supports both blocking and non-blocking modes,
+fully integrates with the eventloop, supports serial ports and tty control.</p></div>
+<div class="paragraph"><p>Note that while most channels are stream channels, some channels (socket types with <em>dgram</em>) are
+datagram channels. For those channels, <a href="#_aio"><strong><code>aio</code></strong></a> <code>recv</code> and <a href="#_aio"><strong><code>aio</code></strong></a> <code>sendto</code> is generally preferable
+over <a href="#_aio"><strong><code>aio</code></strong></a> <code>read</code> and <a href="#_aio"><strong><code>aio</code></strong></a> <code>puts</code>.</p></div>
<div class="sect2">
<h3 id="_aio">aio</h3>
<div class="dlist"><dl>
<dt class="hdlist1">
-<code>$handle <strong>accept</strong> ?addrvar?</code>
+<code>$handle <strong>accept ?-noclose?</strong> ?addrvar?</code>
</dt>
<dd>
<p>
- Server socket only: Accept a connection and return stream.
- If <code><em>addrvar</em></code> is specified, the address of the connected client is stored
- in the named variable in the form <em>addr:port</em> for IP sockets or <em>path</em> for Unix domain sockets.
- See <a href="#_socket"><strong><code>socket</code></strong></a> for details.
+ Server socket only: Accept a connection and return a stream channel.
+ If <code><em>addrvar</em></code> is specified, the address of the connected client is
+ stored in the named variable in the form <em>addr:port</em> for IP sockets
+ or <em>path</em> for Unix domain sockets. See <a href="#_socket"><strong><code>socket</code></strong></a> for details.
+ If <code><em>-noclose</em></code> is given, the returned handle is not automatically
+ closed for child proceses. See <a href="#_socket"><strong><code>socket</code></strong></a> for details.
</p>
</dd>
<dt class="hdlist1">
-<code>$handle <strong>buffering none|line|full</strong></code>
+<code>$handle <strong>buffering none|line|full</strong> ?size?</code>
</dt>
<dd>
<p>
- Sets the buffering mode of the stream.
+ Sets the output buffering mode of the stream channel. <code><em>none</em></code> means
+ that puts immediately writes output. <code><em>line</em></code> means output (including
+ previously buffered output) is written if a newline is to be written.
+ <code><em>full</em></code> means that data is written when the output buffer is full
+ (default 64KB). Size may be specified in full mode.
+ Note that line buffering will also write
+ once the output buffer limit is reached, even if there is no newline.
+ Channels usually begin in full buffering mode, unless they identify
+ as a tty channel, in which case line buffering is used, and <code>stderr</code>
+ begins with no buffering. Returns the current buffering mode (including
+ size in full mode - e.g. <code><em>line</em></code> or <code><em>full 65536</code></em>.
+ See also <a href="#_aio"><strong><code>aio</code></strong></a> <code>puts</code> and <a href="#_aio"><strong><code>aio</code></strong></a> <code>flush</code>.
</p>
</dd>
<dt class="hdlist1">
-<code>$handle <strong>close ?r(ead)|w(rite)|-nodelete?</strong></code>
+<code>$handle <strong>close ?r(ead)|w(rite)? ?-nodelete?</strong></code>
</dt>
<dd>
<p>
@@ -7481,16 +7835,17 @@ what options were selected when Jim Tcl was built.</p></div> The <code><em>read</em></code> and <code><em>write</em></code> arguments perform a "half-close" on a socket. See the <em>shutdown(2)</em> man page.
The <code><em>-nodelete</em></code> option is applicable only for Unix domain sockets. It closes the socket
but does not delete the bound path (e.g. after <a href="#cmd_1"><strong><code>os.fork</code></strong></a>).
+ After a full close, the channel handle is no longer valid.
</p>
</dd>
<dt class="hdlist1">
-<code>$handle <strong>copyto</strong> <em>tofd ?size?</em></code>
+<code>$handle <strong>copyto</strong> <em>$tohandle ?size?</em></code>
</dt>
<dd>
<p>
- Copy bytes to the file descriptor <code><em>tofd</em></code>. If <code><em>size</em></code> is specified, at most
+ Copy bytes to channel <code><em>$tohandle</em></code>. If <code><em>size</em></code> is specified, at most
that many bytes will be copied. Otherwise copying continues until the end
- of the input file. Returns the number of bytes actually copied.
+ of the input channel. Returns the number of bytes actually copied.
</p>
</dd>
<dt class="hdlist1">
@@ -7498,7 +7853,8 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Returns 1 if stream is at eof
+ Returns 1 if an end-of-file condition has occurred on the channel. Note that
+ this condition may only be checked after reading from the channel.
</p>
</dd>
<dt class="hdlist1">
@@ -7507,8 +7863,9 @@ what options were selected when Jim Tcl was built.</p></div> <dd>
<p>
Returns the original filename associated with the handle.
- Handles returned by <a href="#_socket"><strong><code>socket</code></strong></a> provide different information.
- See <a href="#_socket"><strong><code>socket</code></strong></a> for each socket type.
+ Handles returned by <a href="#_socket"><strong><code>socket</code></strong></a> provide different information such as the peer address
+ or a generic name if no useful filename can be provided.
+ See <a href="#_socket"><strong><code>socket</code></strong></a> for each socket type.
</p>
</dd>
<dt class="hdlist1">
@@ -7516,15 +7873,42 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Flush the stream
+ Flushes any output that has been buffered for the channel.
+ In blocking mode, command does not return until all data has been written.
+ In non-blocking mode, the behaviour depends on whether an <a href="#_aio"><strong><code>aio</code></strong></a> <code>writable</code> handler
+ has been set. If it has, and not all data could be written and error will be returned
+ with the message "send buffer full". Otherwise an "autoflush" eventloop handler is installed
+ to flush the remaining data. As long as the eventloop runs (<a href="#cmd_2"><strong><code>vwait</code></strong></a>, <a href="#cmd_2"><strong><code>update</code></strong></a>), the write
+ data will be automatically flushed.
</p>
</dd>
<dt class="hdlist1">
-<code>$handle <strong>gets</strong> <em>?var?</em></code>
+<code>$handle <strong>gets</strong> <em>?varName?</em></code>
</dt>
<dd>
<p>
- Read one line and return it or store it in the var
+ Read one line from the cannel and return it or store it in the
+ var A terminating newline character is discarded. If <code><em>varName</em></code>
+ is specified, then the line is placed in the variable by that name
+ and the return value is a count of the number of characters read
+ (not including the newline). If the end of the file is reached
+ before reading any characters then -1 is returned and <code><em>varName</em></code>
+ is set to an empty string. If <code><em>varName</em></code> is not specified then
+ the return value will be the line (minus the newline character) or
+ an empty string if the end of the file is reached before reading
+ any characters. An empty string will also be returned if a line
+ contains no characters except the newline, so <a href="#_eof"><strong><code>eof</code></strong></a> may have to be
+ used to determine what really happened. If the last character in
+ the file is not a newline character, then <a href="#_gets"><strong><code>gets</code></strong></a> behaves as if there
+ were an additional newline character at the end of the file.
+</p>
+</dd>
+<dt class="hdlist1">
+<code>$handle <strong>getfd</strong></code>
+</dt>
+<dd>
+<p>
+ Returns the underlying file descriptor. On Unix platforms this is a small integer.
</p>
</dd>
<dt class="hdlist1">
@@ -7532,7 +7916,7 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Returns 1 if the stream is a tty device.
+ Returns 1 if the channel is a tty device.
</p>
</dd>
<dt class="hdlist1">
@@ -7540,13 +7924,12 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Apply a POSIX lock to the open file associated with the handle using
- <em>fcntl(F_SETLK)</em>, or <em>fcntl(F_SETLKW)</em> to wait for the lock to be available if <code><em>-wait</em></code>
- is specified.
- The handle must be open for write access.
- Returns 1 if the lock was successfully obtained, 0 otherwise.
- An error occurs if the handle is not suitable for locking (e.g.
- if it is not open for write)
+ Apply a POSIX lock to the open file associated with the channel using
+ <em>fcntl(F_SETLK)</em>, or <em>fcntl(F_SETLKW)</em> to wait for the lock to be
+ available if <code><em>-wait</em></code> is specified. The channel must be open for
+ write access. Returns 1 if the lock was successfully obtained,
+ 0 otherwise. An error occurs if the channel is not suitable for
+ locking (e.g. if it is not open for write)
</p>
</dd>
<dt class="hdlist1">
@@ -7554,9 +7937,9 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Set O_NDELAY (if arg). Returns current/new setting.
- Note that in general ANSI I/O interacts badly with non-blocking I/O.
- Use with care.
+ With no argument, returns the non-blocking status of the channel
+ (1 means non-blocking). With an arguments, sets the non-blocking
+ status of the channel.
</p>
</dd>
<dt class="hdlist1">
@@ -7568,11 +7951,14 @@ what options were selected when Jim Tcl was built.</p></div> </p>
</dd>
<dt class="hdlist1">
-<code>$handle <strong>puts ?-nonewline?</strong> <em>str</em></code>
+<code>$handle <strong>puts ?-nonewline?</strong> <em>string</em></code>
</dt>
<dd>
<p>
- Write the string, with newline unless -nonewline
+ Writes the characters given by <code><em>string</em></code> to the channel given
+ With <code><em>-nonewline</em></code>, the string is written as-is to the channel.
+ Otherwise a newline character is written after the string.
+ See <a href="#_aio"><strong><code>aio</code></strong></a> <code>buffering</code> and <a href="#_aio"><strong><code>aio</code></strong></a> <code>flush</code> for how output is buffered.
</p>
</dd>
<dt class="hdlist1">
@@ -7580,7 +7966,26 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Read and return bytes from the stream. To eof if no len. See <a href="#_read"><strong><code>read</code></strong></a>.
+ Read and return bytes from the channel.
+ If <em>len</em> is not given, reads until end-of-file.
+ reading from non-blocking channels.
+ For backward compatibility, <code><em>-pending</em></code> is accepted, but ignored.
+ If the <code>-nonewline</code> switch is specified then the last
+ character (at end-of-file) is discarded if it is a newline.
+ Note that read on a non-blocking channel may read less than the
+ expected number of bytes (including zero). Use <a href="#_aio"><strong><code>aio</code></strong></a> <code>eof</code> to determine
+ if the end-of-file has been reached.
+</p>
+</dd>
+<dt class="hdlist1">
+<code>$handle <strong>readsize</strong> ?size?'</code>
+</dt>
+<dd>
+<p>
+ Sets or returns the current size of the read buffer used
+ for read, gets and copyto.
+ Defaults to 256, but can be increased to improve performance
+ for large reads.
</p>
</dd>
<dt class="hdlist1">
@@ -7588,7 +7993,7 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Receives a message from the handle via recvfrom(2) and returns it.
+ Receives a message from the datagram channel via recvfrom(2) and returns it.
At most <code><em>maxlen</em></code> bytes are read. If <code><em>addrvar</em></code> is specified, the sending address
of the message is stored in the named variable in the form <em>addr:port</em> for IP sockets
or <em>path</em> for Unix domain sockets. See <a href="#_socket"><strong><code>socket</code></strong></a> for details.
@@ -7599,15 +8004,55 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Seeks in the stream (default <em>current</em>)
+ Change the current access position for the channel. This is only applicable
+ to regular files, not sockets.
+ The <code><em>offset</em></code> and <code><em>origin</em></code> arguments specify the position at
+ which the next read or write will occur for <code><em>fileId</em></code>.
+ <code><em>offset</em></code> must be a number (which may be negative) and <code><em>origin</em></code>
+ must be one of the following:
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>start</strong></code>
+</dt>
+<dd>
+<p>
+ The new access position will be <code><em>offset</em></code> bytes from the start
+ of the file.
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>current</strong></code>
+</dt>
+<dd>
+<p>
+ The new access position will be <code><em>offset</em></code> bytes from the current
+ access position; a negative <code><em>offset</em></code> moves the access position
+ backwards in the file.
</p>
</dd>
<dt class="hdlist1">
+<code><strong>end</strong></code>
+</dt>
+<dd>
+<p>
+ The new access position will be <code><em>offset</em></code> bytes from the end of
+ the file. A negative <code><em>offset</em></code> places the access position before
+ the end-of-file, and a positive <code><em>offset</em></code> places the access position
+ after the end-of-file.
+</p>
+</dd>
+</dl></div>
+<div class="paragraph"><p>The <code><em>origin</em></code> argument defaults to <code>start</code>.</p></div>
+<div class="paragraph"><p>This command returns an empty string.</p></div>
+<div class="dlist"><dl>
+<dt class="hdlist1">
<code>$handle <strong>sendto</strong> <em>str ?address</em></code>
</dt>
<dd>
<p>
- Sends the string, <code><em>str</em></code>, to the given address (host:port or path) via the socket using <em>sendto(2)</em>.
+ Sends the string, <code><em>str</em></code>, to the given address (host:port or path) via datagram socket channel
+ using <em>sendto(2)</em>.
This is intended for udp/dgram sockets and may give an error or behave in unintended
ways for other handle types.
Returns the number of bytes written.
@@ -7618,7 +8063,7 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Returns the bound address or path of the socket. See <em>getsockname(2)</em>.
+ Returns the bound address or path of the socket channel. See <em>getsockname(2)</em>.
</p>
</dd>
<dt class="hdlist1">
@@ -7626,7 +8071,7 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Implements the same functionality as <a href="#_file"><strong><code>file</code></strong></a> <code>stat</code> for a filehandle.
+ Implements the same functionality as <a href="#_file"><strong><code>file</code></strong></a> <code>stat</code> for a file channel.
Only available on platforms that support <em>fstat(2)</em> or equivalent.
</p>
</dd>
@@ -7635,11 +8080,12 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- With no arguments, returns a dictionary of socket options currently set for the handle
- (will be empty for a non-socket). With <code><em>name</em></code> and <code><em>value</em></code>, sets the socket option
- to the given value. Currently supports the following boolean socket options:
- <code>broadcast, debug, keepalive, nosigpipe, oobinline, tcp_nodelay</code>, and the following
- integer socket options: <code>sndbuf, rcvbuf</code>
+ With no arguments, returns a dictionary of socket options currently
+ set for the socket channel (will be empty for a non-socket). With
+ <code><em>name</em></code> and <code><em>value</em></code>, sets the socket option to the given
+ value. Currently supports the following boolean socket options:
+ <code>broadcast, debug, keepalive, nosigpipe, oobinline, tcp_nodelay</code>,
+ and the following integer socket options: <code>sndbuf, rcvbuf</code>
</p>
</dd>
<dt class="hdlist1">
@@ -7647,8 +8093,25 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Flush the stream, then <em>fsync(2)</em> to commit any changes to storage.
+ Flushes the channel, then calls <em>fsync(2)</em> to commit any changes to storage.
Only available on platforms that support <em>fsync(2)</em>.
+ If the flush fails (perhaps because the channel is non-blocking), an error
+ will be returned instead. Although this is designed for normal files and
+ those should be used in blocking mode.
+</p>
+</dd>
+<dt class="hdlist1">
+<code>$handle <strong>taint source|sink ?0:n?</strong></code>
+</dt>
+<dd>
+<p>
+ Sets the taint characteristics of the channel. Data read from
+ the channel will have a taint value as set by <code><em>source</em></code>, while
+ a check will be made against data written to the channel against
+ the <code><em>sink</em></code> value. If the taint of the data and the channel
+ match, the operation will fail. By default, channels created
+ by <a href="#_open"><strong><code>open</code></strong></a> are not tainted while channels created by <a href="#_socket"><strong><code>socket</code></strong></a>
+ have both set to 1.
</p>
</dd>
<dt class="hdlist1">
@@ -7656,7 +8119,29 @@ what options were selected when Jim Tcl was built.</p></div> </dt>
<dd>
<p>
- Returns the current seek position
+ Returns the current seek position or -1 if the channel is not seekable.
+</p>
+</dd>
+<dt class="hdlist1">
+<code>$handle <strong>timeout</strong> <em>?ms?</em></code>
+</dt>
+<dd>
+<p>
+ With no argument, returns the current timeout of the channel, in milliseconds.
+ If an argument is given, it is set as the timeout of the channel, in milliseconds.
+ See <a href="#_aio"><strong><code>aio</code></strong></a> <code>read</code> and <a href="#_aio"><strong><code>aio</code></strong></a> <code>gets</code> for command that use the timeout.
+ Note that the timeout is only used if the channel is in blocking mode.
+</p>
+</dd>
+<dt class="hdlist1">
+<code>$handle <strong>translation binary|text</strong></code>
+</dt>
+<dd>
+<p>
+ This has no effect on Unix platforms, but on Windows it changes the mode of the file
+ handle to binary or text. In general, use "wb" as the open mode instead, but this
+ can be useful on existing filehandles such as <code>stdout</code> and <code>stderr</code>. It is probably
+ a good idea to do this immediately before sending any output.
</p>
</dd>
<dt class="hdlist1">
@@ -7665,7 +8150,7 @@ what options were selected when Jim Tcl was built.</p></div> <dd>
<p>
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 <code>setting value ...</code>
+ If arguments are given, they must either be a dictionary, or <code>setting value ...</code>.
Abbreviations are supported for both settings and values, so the following is acceptable:
<code>$f tty parity e input c out raw</code>.
Only available on platforms that support <em>termios(3)</em>. Supported settings are:
@@ -7753,6 +8238,63 @@ what options were selected when Jim Tcl was built.</p></div> Timeout for noncanonical read (units of 0.1 seconds)
</p>
</dd>
+<dt class="hdlist1">
+<code><strong>vstart</strong> <em>char</em></code>
+</dt>
+<dd>
+<p>
+ Start character for xonoff, usually 0x11 (^Q)
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>vstop</strong> <em>char</em></code>
+</dt>
+<dd>
+<p>
+ Stop character for xonoff, usually 0x13 (^S)
+</p>
+</dd>
+</dl></div>
+</dd>
+<dt class="hdlist1">
+<code>$handle <strong>ttycontrol</strong> ?settings?</code>
+</dt>
+<dd>
+<p>
+ If no arguments are given, returns a dictionary containing the modem control signals
+ from the stream (must be a serial-type device). e.g. <code>{rts 1 dtr 1 dcd 0 dsr 0 ring 0 cts 0}</code>.
+ Note that <code>rts</code> and <code>dtr</code> are controlled by the local system while the other signals reflect
+ the remote system.
+ If arguments are given, they must either be a dictionary, or <code>setting value ...</code>.
+ Abbreviations are supported for both settings and values.
+ Supported settings are:
+</p>
+<div class="dlist"><dl>
+<dt class="hdlist1">
+<code><strong>rts 0|1</strong></code>
+</dt>
+<dd>
+<p>
+ Set the RTS (Request To Send) signal
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>dtr 0|1</strong></code>
+</dt>
+<dd>
+<p>
+ Set the DTR (Data Terminal Ready) signal
+</p>
+</dd>
+<dt class="hdlist1">
+<code><strong>break</strong> <em>duration</em></code>
+</dt>
+<dd>
+<p>
+ Generate a break condition. <code>duration</code> is generally ignored but may be used
+ in a platform-dependent manner.
+</p>
+</dd>
</dl></div>
</dd>
<dt class="hdlist1">
@@ -7792,6 +8334,26 @@ what options were selected when Jim Tcl was built.</p></div> </p>
</dd>
</dl></div>
+<div class="paragraph"><p><strong>Buffering, non-blocking and timeouts</strong></p></div>
+<div class="paragraph"><p>Channels normally operate in blocking mode. This means that reads (gets,
+read, copyto) block until data is received or end-of-file is reached,
+or an error occurs. Similarly, writes (puts, copyto) block if the channel
+is not current writable.</p></div>
+<div class="paragraph"><p>It is possible to set a timeout for blocking reads with <a href="#_aio"><strong><code>aio</code></strong></a> <code>timeout</code>,
+generally useful on stream socket channels. If a timeout is specified
+for a channel (the default is 0/indefinite), a blocking read will return
+with no data if the timeout expires without reading any data.</p></div>
+<div class="paragraph"><p>For some applications, and especially when using the eventloop, blocking
+I/O and timeouts are not appropriate. Instead we wish to read what is
+available, and write what is possible in the <code>readable</code> and <code>writable</code>
+scripts and then return until the next event. This can be achived by
+setting a channel non-blocking mode with <a href="#_aio"><strong><code>aio</code></strong></a> <code>ndelay</code>. In this case, <a href="#_aio"><strong><code>aio</code></strong></a> <code>read</code>, <a href="#_aio"><strong><code>aio</code></strong></a> <code>gets</code>
+and <a href="#_aio"><strong><code>aio</code></strong></a> <code>puts</code> will return early if they would otherwise block, performing
+us much work as posssible. For example, <a href="#_aio"><strong><code>aio</code></strong></a> <code>read</code> may return less data than requested
+and <a href="#_aio"><strong><code>aio</code></strong></a> <code>puts</code> may write less data than requested (although see <a href="#_aio"><strong><code>aio</code></strong></a> <code>flush</code> about
+additional write data can be automatically flushed). If <a href="#_aio"><strong><code>aio</code></strong></a> <code>gets</code> does not receive an
+entire line, it returns -1. In all these cases <a href="#_aio"><strong><code>aio</code></strong></a> <code>eof</code> can be used to determine
+if end-of-file was reached.</p></div>
</div>
<div class="sect2">
<h3 id="_fconfigure">fconfigure</h3>
@@ -7817,7 +8379,7 @@ what options were selected when Jim Tcl was built.</p></div> </li>
<li>
<p>
-<a href="#_fconfigure"><strong><code>fconfigure</code></strong></a> <code>... -translation</code> is accepted but ignored
+<a href="#_fconfigure"><strong><code>fconfigure</code></strong></a> <code>... -translation</code> maps to <a href="#_aio"><strong><code>aio</code></strong></a> <code>translation</code> and suppports only <code>binary</code> and <code>text</code>
</p>
</li>
</ul></div>
@@ -7913,7 +8475,7 @@ handler is removed.</p></div> </p>
</dd>
<dt class="hdlist1">
-<code><strong>vwait ?-signal?</strong> <em>variable</em></code>
+<code><strong>vwait ?-signal?</strong> <em>variable</em> ?script?</code>
</dt>
<dd>
<p>
@@ -7921,9 +8483,11 @@ handler is removed.</p></div> events until the named (global) variable changes or all
event handlers are removed. The variable need not exist
beforehand. If there are no event handlers defined, <a href="#cmd_2"><strong><code>vwait</code></strong></a>
- returns immediately. If <code><em>-signal</em></code> is specified, <a href="#cmd_2"><strong><code>vwait</code></strong></a> will
+ returns immediately. If <code><strong>-signal</strong></code> is specified, <a href="#cmd_2"><strong><code>vwait</code></strong></a> will
also quit if a handled signal occurs. In this case, <a href="#_signal"><strong><code>signal</code></strong></a> <code>check -clear</code>
- can be used to check for the signal that occurred.
+ can be used to check for the signal that occurred. If <code><em>script</em></code> is given
+ it is evaluated after each event. If it returns break, <a href="#cmd_2"><strong><code>vwait</code></strong></a> returns.
+ <a href="#cmd_2"><strong><code>vwait</code></strong></a> also returns with an error if the script returns an error.
</p>
</dd>
<dt class="hdlist1">
@@ -7958,109 +8522,109 @@ to prevent infinite errors. (A time event handler is always removed after execut </div>
<div class="sect2">
<h3 id="_socket">socket</h3>
-<div class="paragraph"><p>Various socket types may be created.</p></div>
+<div class="paragraph"><p>Various socket types may be created as follows.</p></div>
<div class="dlist"><dl>
<dt class="hdlist1">
-<code><strong>socket unix</strong> <em>path</em></code>
+<code><strong>socket ?-noclose? unix</strong> <em>path</em></code>
</dt>
<dd>
<p>
A unix domain socket client connected to <em>path</em>
- <em>filename</em> returns <code><em>path</em></code>
+ <em>filename</em> returns <code><em>path</em></code>
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket unix.server</strong> <em>path</em></code>
+<code><strong>socket ?-noclose? unix.server</strong> <em>path</em></code>
</dt>
<dd>
<p>
A unix domain socket server listening on <em>path</em>
- <em>filename</em> returns <code><em>path</em></code>
+ <em>filename</em> returns <code><em>path</em></code>
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket unix.dgram</strong> <em>?path?</em></code>
+<code><strong>socket ?-noclose? unix.dgram</strong> <em>?path?</em></code>
</dt>
<dd>
<p>
A unix domain socket datagram client, optionally connected to <em>path</em>
- <em>filename</em> returns <code><em>path</em></code> if provided or "dgram" if not
+ <em>filename</em> returns <code><em>path</em></code> if provided or "dgram" if not
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket unix.dgram.server</strong> <em>path</em></code>
+<code><strong>socket ?-noclose? unix.dgram.server</strong> <em>path</em></code>
</dt>
<dd>
<p>
A unix domain socket datagram server server listening on <em>path</em>
- <em>filename</em> returns <code><em>path</em></code>
+ <em>filename</em> returns <code><em>path</em></code>
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket ?-async? ?-ipv6? stream</strong> <em>addr:port</em></code>
+<code><strong>socket ?-noclose? ?-async? ?-ipv6? stream</strong> <em>addr:port</em></code>
</dt>
<dd>
<p>
A TCP socket client. (See the forms for <code><em>addr</em></code> below)
- <em>filename</em> returns <code><em>addr:port</em></code>
+ <em>filename</em> returns <code><em>addr:port</em></code>
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket ?-async? ?-ipv6? stream.server</strong> <em>?addr:?port</em></code>
+<code><strong>socket ?-noclose? ?-async? ?-ipv6? stream.server</strong> <em>?addr:?port</em></code>
</dt>
<dd>
<p>
A TCP socket server (<code><em>addr</em></code> defaults to <code>0.0.0.0</code> for IPv4 or <code>[::]</code> for IPv6).
- <em>filename</em> returns <code><em>addr:port</em></code>
+ <em>filename</em> returns <code><em>addr:port</em></code>
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket ?-async? ?-ipv6? dgram</strong> ?<em>addr:port</em>?</code>
+<code><strong>socket ?-noclose? ?-async? ?-ipv6? dgram</strong> ?<em>addr:port</em>?</code>
</dt>
<dd>
<p>
A UDP socket client. If the address is not specified,
the client socket will be unbound and <em>sendto</em> must be used
to indicated the destination.
- <em>filename</em> returns <code><em>addr:port</em></code> if provided or "dgram" if not
+ <em>filename</em> returns <code><em>addr:port</em></code> if provided or "dgram" if not
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket ?-async? ?-ipv6? dgram.server</strong> <em>addr:port</em></code>
+<code><strong>socket ?-noclose? ?-async? ?-ipv6? dgram.server</strong> <em>addr:port</em></code>
</dt>
<dd>
<p>
A UDP socket server.
- <em>filename</em> returns <code><em>addr:port</em></code>
+ <em>filename</em> returns <code><em>addr:port</em></code>
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket pipe</strong></code>
+<code><strong>socket ?-noclose? pipe</strong></code>
</dt>
<dd>
<p>
A synonym for <a href="#_pipe"><strong><code>pipe</code></strong></a>
- <em>filename</em> returns "pipe"
+ <em>filename</em> returns "pipe"
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket pair</strong></code>
+<code><strong>socket ?-noclose? pair</strong></code>
</dt>
<dd>
<p>
A socketpair (see socketpair(2)). Like <a href="#_pipe"><strong><code>pipe</code></strong></a>, this command returns
a list of two channels: {s1 s2}. These channels are both readable and writable.
- <em>filename</em> returns "pair"
+ <em>filename</em> returns "pair"
</p>
</dd>
<dt class="hdlist1">
-<code><strong>socket pty</strong></code>
+<code><strong>socket ?-noclose? pty</strong></code>
</dt>
<dd>
<p>
A pseudo-tty pair (see openpty(3)). Like <a href="#_pipe"><strong><code>pipe</code></strong></a>, this command returns
a list of two channels: {primary replica}. These channels are both readable and writable.
- <em>filename</em> for both handles returns the replica filename.
+ <em>filename</em> for both handles returns the replica filename.
</p>
</dd>
</dl></div>
@@ -8149,6 +8713,14 @@ will succeed if connected or fail if connect failed. Typical usage is as follows vwait done</code></pre>
</div></div>
+<div class="paragraph"><p>If <em><code>-noclose</code></em> is specified, the socket is not automatically closed for child proceses. e.g.</p></div>
+<div class="listingblock">
+<div class="content">
+<pre><code> lassign [socket -noclose pipe] r w
+ # This file descriptor will be open in the child process
+ # with the file descriptors passed on the command line
+ exec subcommand [$r getfd] [$w getfd]</code></pre>
+</div></div>
</div>
<div class="sect2">
<h3 id="_syslog">syslog</h3>
@@ -8532,6 +9104,50 @@ be replaced with a custom command instead if desired.</p></div> </dl></div>
</div>
<div class="sect2">
+<h3 id="_tcl_stdhint">tcl::stdhint</h3>
+<div class="paragraph"><p>Scriptable hinting is supported in the interactive shell, <em>jimsh</em>, through
+the <a href="#_tcl_stdhint"><strong><code>tcl::stdhint</code></strong></a> callback. A simple implementation is provided, however this may
+be replaced with a custom command instead if desired.</p></div>
+<div class="paragraph"><p>In the interactive shell, press <TAB> to activate command line completion.</p></div>
+<div class="dlist"><dl>
+<dt class="hdlist1">
+<code><strong>tcl::stdhint</strong> <em>commandline</em></code>
+</dt>
+<dd>
+<p>
+ This command is called with the current command line. It should return a list of <code><strong>{hint ?ANSI cols?}</strong></code> or ""
+ if no hint is available.
+ For example, if passed <code><strong>"dict get"</strong></code> it could return <code><strong>{"dict get dictionary ?key …?" 36 1}</strong></code> to show the given hint
+ in light cyan.
+</p>
+</dd>
+</dl></div>
+<div class="paragraph"><p>The built-in <a href="#_tcl_stdhint"><strong><code>tcl::stdhint</code></strong></a> callback uses <em>tcl::stdhint_col</em> for the colour. <em>tcl::stdhint_cols</em> can be used
+to easily change this colour, e.g. in ~/.jimrc.</p></div>
+<div class="listingblock">
+<div class="content">
+<pre><code> . parray tcl::stdhint_cols
+ tcl::stdhint_cols(black) = 30
+ tcl::stdhint_cols(blue) = 34
+ tcl::stdhint_cols(cyan) = 36
+ tcl::stdhint_cols(gray) = 30 1
+ tcl::stdhint_cols(green) = 32
+ tcl::stdhint_cols(grey) = 30 1
+ tcl::stdhint_cols(lblue) = 34 1
+ tcl::stdhint_cols(lcyan) = 36 1
+ tcl::stdhint_cols(lgreen) = 32 1
+ tcl::stdhint_cols(lpurple) = 35 1
+ tcl::stdhint_cols(lred) = 31 1
+ tcl::stdhint_cols(lyellow) = 33 1
+ tcl::stdhint_cols(none) = 0
+ tcl::stdhint_cols(normal) = 37
+ tcl::stdhint_cols(purple) = 35
+ tcl::stdhint_cols(red) = 31
+ tcl::stdhint_cols(white) = 37 1
+ tcl::stdhint_cols(yellow) = 33</code></pre>
+</div></div>
+</div>
+<div class="sect2">
<h3 id="_history">history</h3>
<div class="paragraph"><p>The optional history extension provides script access to the command line editing
and history support available in <em>jimsh</em>. See <em>examples/jtclsh.tcl</em> for an example.
@@ -8567,6 +9183,15 @@ the remaining subcommands do nothing.</p></div> </p>
</dd>
<dt class="hdlist1">
+<code><strong>history hints</strong> <em>command</em></code>
+</dt>
+<dd>
+<p>
+ Sets a hinting command (see <a href="#_tcl_stdhint"><strong><code>tcl::stdhint</code></strong></a>) that is active during <a href="#_history"><strong><code>history</code></strong></a> <code>getline</code>.
+ If the command is empty, hinting is disabled.
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>history add</strong> <em>line</em></code>
</dt>
<dd>
@@ -8605,6 +9230,16 @@ the remaining subcommands do nothing.</p></div> <div class="paragraph"><p>Provides namespace-related functions. See also: <a href="http://www.tcl.tk/man/tcl8.6/TclCmd/namespace.htm">http://www.tcl.tk/man/tcl8.6/TclCmd/namespace.htm</a></p></div>
<div class="dlist"><dl>
<dt class="hdlist1">
+<code><strong>namespace canonical</strong> ?current? ?name?</code>
+</dt>
+<dd>
+<p>
+ Returns the full name of <code><em>name</em></code> within namespace <em><code>current</code></em>.
+ If <em><code>current</code></em> is not given, <a href="#_namespace"><strong><code>namespace</code></strong></a> <code>current</code> is used.
+ If neither are given, returns the current namespace (not qualified with a leading <em>::</em>).
+</p>
+</dd>
+<dt class="hdlist1">
<code><strong>namespace code</strong> <em>script</em></code>
</dt>
<dd>
@@ -8631,7 +9266,7 @@ the remaining subcommands do nothing.</p></div> </p>
</dd>
<dt class="hdlist1">
-<code><strong>namespace ensemble create</strong>'</code>
+<code><strong>namespace ensemble create</strong></code>
</dt>
<dd>
<p>
@@ -8971,14 +9606,16 @@ by the Tcl library.</p></div> </dl></div>
<div class="listingblock">
<div class="content">
-<pre><code> tcl_platform(byteOrder) = littleEndian
+<pre><code> tcl_platform(bootstrap) = 0
+ tcl_platform(byteOrder) = littleEndian
tcl_platform(engine) = Jim
- tcl_platform(os) = Darwin
+ tcl_platform(os) = darwin
+ tcl_platform(pathSeparator) = :
tcl_platform(platform) = unix
tcl_platform(pointerSize) = 8
+ tcl_platform(stackFormat) = 4
tcl_platform(threaded) = 0
- tcl_platform(wordSize) = 8
- tcl_platform(pathSeparator) = :</code></pre>
+ tcl_platform(wordSize) = 8</code></pre>
</div></div>
<div class="dlist"><dl>
<dt class="hdlist1">
@@ -9016,6 +9653,15 @@ by the Tcl library.</p></div> The value of argv[0] when jimsh was invoked.
</p>
</dd>
+<dt class="hdlist1">
+<code><strong>jim::lineedit</strong></code>
+</dt>
+<dd>
+<p>
+ This variables is set to 1 if jimsh was configured with line editing support,
+ or 0 if not.
+</p>
+</dd>
</dl></div>
<div class="paragraph"><p>The following variables have special meaning to Jim Tcl:</p></div>
<div class="dlist"><dl>
@@ -1,7 +1,7 @@ # vim:se syn=tcl: # -define JIM_VERSION 82 +define JIM_VERSION 84 options-defaults { silent-rules 1 @@ -28,9 +28,10 @@ options { full allextmod => "Enable all non-default extensions as modules if prerequisites are found" compat => "Enable some backward compatibility behaviour" + taint=1 => "Disable taint support" 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" + jim-regexp=1 => "Prefer POSIX regex 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" @@ -482,10 +483,15 @@ if {[opt-bool compat]} { msg-result "Enabling compatibility mode" define JIM_COMPAT } + if {![opt-bool introspection]} { msg-result "Disabling introspection" define JIM_NO_INTROSPECTION } +if {[opt-bool taint]} { + msg-result "Enabling taint support" + define JIM_TAINT +} if {[opt-bool shared with-jim-shared]} { msg-result "Building shared library" } else { @@ -493,6 +499,11 @@ if {[opt-bool shared with-jim-shared]} { define JIM_STATICLIB } define VERSION [format %.2f [expr {[get-define JIM_VERSION] / 100.0}]] +set githash [get-define VERSION] +catch { + set githash [exec git describe --dirty] +} +define JIM_GITVERSION $githash define LIBSOEXT [format [get-define SH_SOEXTVER] [get-define VERSION]] if {[get-define libdir] ni {/lib /usr/lib /usr/lib64}} { define SH_LINKRPATH_FLAGS [format [get-define SH_LINKRPATH] [get-define libdir]] @@ -549,7 +560,7 @@ if {$withinfo(without) eq "default"} { # Now go check everything - see autosetup/local.tcl array set extinfo [check-extensions [opt-bool allextmod]] -set buildjimext 1 +define BUILD_JIM_EXT 1 # Now special checks if {[have-feature windows]} { @@ -560,7 +571,7 @@ if {[have-feature windows]} { user-error "cygwin/mingw require --shared for dynamic modules" } else { user-notice "Building static library, so build-jim-ext will not work on cygwin/mingw" - set buildjimext 0 + define BUILD_JIM_EXT 0 } } } else { @@ -663,12 +674,12 @@ foreach mod $extinfo(module-c) { } define BUILD_SHOBJS [join $lines \n] -make-config-header jim-config.h -auto {HAVE_LONG_LONG* JIM_UTF8 SIZEOF_INT} -bare JIM_VERSION -none * +make-config-header jim-config.h -auto {HAVE_LONG_LONG* JIM_UTF8 JIM_TAINT JIM_GITVERSION SIZEOF_INT} -bare JIM_VERSION -none * 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 -if {$buildjimext} { +if {[get-define BUILD_JIM_EXT]} { make-template build-jim-ext.in catch {exec chmod +x build-jim-ext} } diff --git a/autosetup/README.autosetup b/autosetup/README.autosetup index 30bef32..3952980 100644 --- a/autosetup/README.autosetup +++ b/autosetup/README.autosetup @@ -1,4 +1,4 @@ -README.autosetup created by autosetup v0.7.1+ +README.autosetup created by autosetup v0.7.2 This is the autosetup directory for a local install of autosetup. It contains autosetup, support files and loadable modules. diff --git a/autosetup/autosetup b/autosetup/autosetup index e4d5a31..90f5454 100755 --- a/autosetup/autosetup +++ b/autosetup/autosetup @@ -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.7.1+ +set autosetup(version) 0.7.2 # Can be set to 1 to debug early-init problems set autosetup(debug) [expr {"--debug" in $argv}] @@ -566,7 +566,10 @@ proc options-show {what} { set indent [string repeat " " [expr {$max+4}]] set cols [getenv COLUMNS 80] catch { - lassign [exec stty size] rows cols + lassign [exec stty size] _ sttycols + if {[string is integer -strict $sttycols]} { + set cols $sttycols + } } incr cols -1 # Now output @@ -910,8 +913,7 @@ proc list-non-empty {list} { # Searches the path for an executable with the given name. # Note that the name may include some parameters, e.g. 'cc -mbig-endian', # in which case the parameters are ignored. -# The full path to the executable if found, or "" if not found. -# Returns 1 if found, or 0 if not. +# Returns the full path to the executable if found, or "" if not found. # proc find-executable-path {name} { # Ignore any parameters diff --git a/autosetup/autosetup-config.guess b/autosetup/autosetup-config.guess index e81d3ae..48a6846 100755 --- a/autosetup/autosetup-config.guess +++ b/autosetup/autosetup-config.guess @@ -1,14 +1,14 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright 1992-2021 Free Software Foundation, Inc. +# Copyright 1992-2024 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2021-06-03' +timestamp='2024-07-27' # 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 -# the Free Software Foundation; either version 3 of the License, or +# 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 @@ -47,7 +47,7 @@ me=`echo "$0" | sed -e 's,.*/,,'` usage="\ Usage: $0 [OPTION] -Output the configuration name of the system \`$me' is run on. +Output the configuration name of the system '$me' is run on. Options: -h, --help print this help, then exit @@ -60,13 +60,13 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2021 Free Software Foundation, Inc. +Copyright 1992-2024 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." help=" -Try \`$me --help' for more information." +Try '$me --help' for more information." # Parse command line while test $# -gt 0 ; do @@ -102,8 +102,8 @@ GUESS= # temporary files to be created and, as you can see below, it is a # headache to deal with in a portable fashion. -# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still -# use `HOST_CC' if defined, but it is deprecated. +# Historically, 'CC_FOR_BUILD' used to be named 'HOST_CC'. We still +# use 'HOST_CC' if defined, but it is deprecated. # Portable tmp directory creation inspired by the Autoconf team. @@ -123,7 +123,7 @@ set_cc_for_build() { dummy=$tmp/dummy case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in ,,) echo "int x;" > "$dummy.c" - for driver in cc gcc c89 c99 ; do + for driver in cc gcc c17 c99 c89 ; do if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then CC_FOR_BUILD=$driver break @@ -155,6 +155,9 @@ Linux|GNU|GNU/*) set_cc_for_build cat <<-EOF > "$dummy.c" + #if defined(__ANDROID__) + LIBC=android + #else #include <features.h> #if defined(__UCLIBC__) LIBC=uclibc @@ -162,6 +165,8 @@ Linux|GNU|GNU/*) LIBC=dietlibc #elif defined(__GLIBC__) LIBC=gnu + #elif defined(__LLVM_LIBC__) + LIBC=llvm #else #include <stdarg.h> /* First heuristic to detect musl libc. */ @@ -169,6 +174,7 @@ Linux|GNU|GNU/*) LIBC=musl #endif #endif + #endif EOF cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` eval "$cc_set_libc" @@ -437,7 +443,7 @@ case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in # This test works for both compilers. 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) | \ + (CCOPTS="" $CC_FOR_BUILD -m64 -E - 2>/dev/null) | \ grep IS_64BIT_ARCH >/dev/null then SUN_ARCH=x86_64 @@ -459,7 +465,7 @@ case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in UNAME_RELEASE=`uname -v` ;; esac - # Japanese Language versions have a version number like `4.1.3-JL'. + # Japanese Language versions have a version number like '4.1.3-JL'. SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'` GUESS=sparc-sun-sunos$SUN_REL ;; @@ -628,7 +634,8 @@ EOF sed 's/^ //' << EOF > "$dummy.c" #include <sys/systemcfg.h> - main() + int + main () { if (!__power_pc()) exit(1); @@ -712,7 +719,8 @@ EOF #include <stdlib.h> #include <unistd.h> - int main () + int + main () { #if defined(_SC_KERNEL_BITS) long bits = sysconf(_SC_KERNEL_BITS); @@ -904,7 +912,7 @@ EOF fi ;; *:FreeBSD:*:*) - UNAME_PROCESSOR=`/usr/bin/uname -p` + UNAME_PROCESSOR=`uname -p` case $UNAME_PROCESSOR in amd64) UNAME_PROCESSOR=x86_64 ;; @@ -929,6 +937,9 @@ EOF i*:PW*:*) GUESS=$UNAME_MACHINE-pc-pw32 ;; + *:SerenityOS:*:*) + GUESS=$UNAME_MACHINE-pc-serenity + ;; *:Interix*:*) case $UNAME_MACHINE in x86) @@ -963,11 +974,37 @@ EOF GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'` GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC ;; + x86_64:[Mm]anagarm:*:*|i?86:[Mm]anagarm:*:*) + GUESS="$UNAME_MACHINE-pc-managarm-mlibc" + ;; + *:[Mm]anagarm:*:*) + GUESS="$UNAME_MACHINE-unknown-managarm-mlibc" + ;; *:Minix:*:*) GUESS=$UNAME_MACHINE-unknown-minix ;; aarch64:Linux:*:*) - GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + set_cc_for_build + CPU=$UNAME_MACHINE + LIBCABI=$LIBC + if test "$CC_FOR_BUILD" != no_compiler_found; then + ABI=64 + sed 's/^ //' << EOF > "$dummy.c" + #ifdef __ARM_EABI__ + #ifdef __ARM_PCS_VFP + ABI=eabihf + #else + ABI=eabi + #endif + #endif +EOF + cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'` + eval "$cc_set_abi" + case $ABI in + eabi | eabihf) CPU=armv8l; LIBCABI=$LIBC$ABI ;; + esac + fi + GUESS=$CPU-unknown-linux-$LIBCABI ;; aarch64_be:Linux:*:*) UNAME_MACHINE=aarch64_be @@ -1033,7 +1070,16 @@ EOF k1om:Linux:*:*) GUESS=$UNAME_MACHINE-unknown-linux-$LIBC ;; - loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*) + kvx:Linux:*:*) + GUESS=$UNAME_MACHINE-unknown-linux-$LIBC + ;; + kvx:cos:*:*) + GUESS=$UNAME_MACHINE-unknown-cos + ;; + kvx:mbr:*:*) + GUESS=$UNAME_MACHINE-unknown-mbr + ;; + loongarch32:Linux:*:* | loongarch64:Linux:*:*) GUESS=$UNAME_MACHINE-unknown-linux-$LIBC ;; m32r*:Linux:*:*) @@ -1148,16 +1194,27 @@ EOF ;; x86_64:Linux:*:*) set_cc_for_build + CPU=$UNAME_MACHINE 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 + ABI=64 + sed 's/^ //' << EOF > "$dummy.c" + #ifdef __i386__ + ABI=x86 + #else + #ifdef __ILP32__ + ABI=x32 + #endif + #endif +EOF + cc_set_abi=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^ABI' | sed 's, ,,g'` + eval "$cc_set_abi" + case $ABI in + x86) CPU=i686 ;; + x32) LIBCABI=${LIBC}x32 ;; + esac fi - GUESS=$UNAME_MACHINE-pc-linux-$LIBCABI + GUESS=$CPU-pc-linux-$LIBCABI ;; xtensa*:Linux:*:*) GUESS=$UNAME_MACHINE-unknown-linux-$LIBC @@ -1177,7 +1234,7 @@ EOF GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION ;; i*86:OS/2:*:*) - # If we were able to find `uname', then EMX Unix compatibility + # If we were able to find 'uname', then EMX Unix compatibility # is probably installed. GUESS=$UNAME_MACHINE-pc-os2-emx ;; @@ -1318,7 +1375,7 @@ EOF GUESS=ns32k-sni-sysv fi ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + PENTIUM:*:4.0*:*) # Unisys 'ClearPath HMP IX 4000' SVR4/MP effort # says <Richard.M.Bartel@ccMail.Census.GOV> GUESS=i586-unisys-sysv4 ;; @@ -1364,8 +1421,11 @@ EOF BePC:Haiku:*:*) # Haiku running on Intel PC compatible. GUESS=i586-pc-haiku ;; - x86_64:Haiku:*:*) - GUESS=x86_64-unknown-haiku + ppc:Haiku:*:*) # Haiku running on Apple PowerPC + GUESS=powerpc-apple-haiku + ;; + *:Haiku:*:*) # Haiku modern gcc (not bound by BeOS compat) + GUESS=$UNAME_MACHINE-unknown-haiku ;; SX-4:SUPER-UX:*:*) GUESS=sx4-nec-superux$UNAME_RELEASE @@ -1522,6 +1582,9 @@ EOF i*86:rdos:*:*) GUESS=$UNAME_MACHINE-pc-rdos ;; + i*86:Fiwix:*:*) + GUESS=$UNAME_MACHINE-pc-fiwix + ;; *:AROS:*:*) GUESS=$UNAME_MACHINE-unknown-aros ;; @@ -1534,6 +1597,9 @@ EOF *:Unleashed:*:*) GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE ;; + *:Ironclad:*:*) + GUESS=$UNAME_MACHINE-unknown-ironclad + ;; esac # Do we have a guess based on uname results? @@ -1557,6 +1623,7 @@ cat > "$dummy.c" <<EOF #endif #endif #endif +int main () { #if defined (sony) diff --git a/autosetup/autosetup-config.sub b/autosetup/autosetup-config.sub index d80c5d7..4aaae46 100755 --- a/autosetup/autosetup-config.sub +++ b/autosetup/autosetup-config.sub @@ -1,14 +1,14 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright 1992-2021 Free Software Foundation, Inc. +# Copyright 1992-2024 Free Software Foundation, Inc. -# shellcheck disable=SC2006,SC2268 # see below for rationale +# shellcheck disable=SC2006,SC2268,SC2162 # see below for rationale -timestamp='2021-07-03' +timestamp='2024-05-27' # 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 -# the Free Software Foundation; either version 3 of the License, or +# 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 @@ -76,13 +76,13 @@ Report bugs and patches to <config-patches@gnu.org>." version="\ GNU config.sub ($timestamp) -Copyright 1992-2021 Free Software Foundation, Inc. +Copyright 1992-2024 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." help=" -Try \`$me --help' for more information." +Try '$me --help' for more information." # Parse command line while test $# -gt 0 ; do @@ -120,15 +120,16 @@ case $# in esac # Split fields of configuration type -# shellcheck disable=SC2162 +saved_IFS=$IFS IFS="-" read field1 field2 field3 field4 <<EOF $1 EOF +IFS=$saved_IFS # Separate into logical components for further validation case $1 in *-*-*-*-*) - echo Invalid configuration \`"$1"\': more than four components >&2 + echo "Invalid configuration '$1': more than four components" >&2 exit 1 ;; *-*-*-*) @@ -140,10 +141,21 @@ case $1 in # 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*) + cloudabi*-eabi* \ + | kfreebsd*-gnu* \ + | knetbsd*-gnu* \ + | kopensolaris*-gnu* \ + | linux-* \ + | managarm-* \ + | netbsd*-eabi* \ + | netbsd*-gnu* \ + | nto-qnx* \ + | os2-emx* \ + | rtmk-nova* \ + | storm-chaos* \ + | uclinux-gnu* \ + | uclinux-uclibc* \ + | windows-* ) basic_machine=$field1 basic_os=$maybe_os ;; @@ -158,8 +170,12 @@ case $1 in esac ;; *-*) - # A lone config we happen to match not fitting any pattern case $field1-$field2 in + # Shorthands that happen to contain a single dash + convex-c[12] | convex-c3[248]) + basic_machine=$field2-convex + basic_os= + ;; decstation-3100) basic_machine=mips-dec basic_os= @@ -167,24 +183,88 @@ case $1 in *-*) # Second component is usually, but not always the OS case $field2 in - # Prevent following clause from handling this valid os + # Do not treat sunos as a manufacturer 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) + 3100* \ + | 32* \ + | 3300* \ + | 3600* \ + | 7300* \ + | acorn \ + | altos* \ + | apollo \ + | apple \ + | atari \ + | att* \ + | axis \ + | be \ + | bull \ + | cbm \ + | ccur \ + | cisco \ + | commodore \ + | convergent* \ + | convex* \ + | cray \ + | crds \ + | dec* \ + | delta* \ + | dg \ + | digital \ + | dolphin \ + | encore* \ + | gould \ + | harris \ + | highlevel \ + | hitachi* \ + | hp \ + | ibm* \ + | intergraph \ + | isi* \ + | knuth \ + | masscomp \ + | microblaze* \ + | mips* \ + | motorola* \ + | ncr* \ + | news \ + | next \ + | ns \ + | oki \ + | omron* \ + | pc533* \ + | rebel \ + | rom68k \ + | rombug \ + | semi \ + | sequent* \ + | siemens \ + | sgi* \ + | siemens \ + | sim \ + | sni \ + | sony* \ + | stratus \ + | sun \ + | sun[234]* \ + | tektronix \ + | tti* \ + | ultra \ + | unicom* \ + | wec \ + | winbond \ + | wrs) basic_machine=$field1-$field2 basic_os= ;; + zephyr*) + basic_machine=$field1-unknown + basic_os=$field2 + ;; *) basic_machine=$field1 basic_os=$field2 @@ -265,26 +345,6 @@ case $1 in 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 @@ -707,15 +767,26 @@ case $basic_machine in vendor=dec basic_os=tops20 ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) + delta | 3300 | delta-motorola | 3300-motorola | motorola-delta | motorola-3300) cpu=m68k vendor=motorola ;; - dpx2*) + # This used to be dpx2*, but that gets the RS6000-based + # DPX/20 and the x86-based DPX/2-100 wrong. See + # https://oldskool.silicium.org/stations/bull_dpx20.htm + # https://www.feb-patrimoine.com/english/bull_dpx2.htm + # https://www.feb-patrimoine.com/english/unix_and_bull.htm + dpx2 | dpx2[23]00 | dpx2[23]xx) cpu=m68k vendor=bull - basic_os=sysv3 + ;; + dpx2100 | dpx21xx) + cpu=i386 + vendor=bull + ;; + dpx20) + cpu=rs6000 + vendor=bull ;; encore | umax | mmax) cpu=ns32k @@ -830,18 +901,6 @@ case $basic_machine in next | m*-next) cpu=m68k vendor=next - case $basic_os in - openstep*) - ;; - nextstep*) - ;; - ns2*) - basic_os=nextstep2 - ;; - *) - basic_os=nextstep3 - ;; - esac ;; np1) cpu=np1 @@ -930,12 +989,13 @@ case $basic_machine in ;; *-*) - # shellcheck disable=SC2162 + saved_IFS=$IFS IFS="-" read cpu vendor <<EOF $basic_machine EOF + IFS=$saved_IFS ;; - # We use `pc' rather than `unknown' + # 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) @@ -963,15 +1023,19 @@ unset -v basic_machine # Decode basic machines in the full and proper CPU-Company form. case $cpu-$vendor in - # Here we handle the default manufacturer of certain CPU types in canonical form. It is in - # some cases the only manufacturer, in others, it is the most popular. + # Here we handle the default manufacturer of certain CPU types in canonical form. + # It is in some cases the only manufacturer, in others, it is the most popular. + c[12]-convex | c[12]-unknown | c3[248]-convex | c3[248]-unknown) + vendor=convex + basic_os=${basic_os:-bsd} + ;; craynv-unknown) vendor=cray basic_os=${basic_os:-unicosmp} ;; c90-unknown | c90-cray) vendor=cray - basic_os=${Basic_os:-unicos} + basic_os=${basic_os:-unicos} ;; fx80-unknown) vendor=alliant @@ -1012,11 +1076,34 @@ case $cpu-$vendor in ;; # Here we normalize CPU types with a missing or matching vendor - dpx20-unknown | dpx20-bull) - cpu=rs6000 - vendor=bull + armh-unknown | armh-alt) + cpu=armv7l + vendor=alt + basic_os=${basic_os:-linux-gnueabihf} + ;; + + # Normalized CPU+vendor pairs that imply an OS, if not otherwise specified + m68k-isi) + basic_os=${basic_os:-sysv} + ;; + m68k-sony) + basic_os=${basic_os:-newsos} + ;; + m68k-tektronix) + basic_os=${basic_os:-bsd} + ;; + m88k-harris) + basic_os=${basic_os:-sysv3} + ;; + i386-bull | m68k-bull) + basic_os=${basic_os:-sysv3} + ;; + rs6000-bull) basic_os=${basic_os:-bosx} ;; + mips-sni) + basic_os=${basic_os:-sysv4} + ;; # Here we normalize CPU types irrespective of the vendor amd64-*) @@ -1024,7 +1111,7 @@ case $cpu-$vendor in ;; blackfin-*) cpu=bfin - basic_os=linux + basic_os=${basic_os:-linux} ;; c54x-*) cpu=tic54x @@ -1047,7 +1134,7 @@ case $cpu-$vendor in ;; m68knommu-*) cpu=m68k - basic_os=linux + basic_os=${basic_os:-linux} ;; m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*) cpu=s12z @@ -1057,12 +1144,12 @@ case $cpu-$vendor in ;; parisc-*) cpu=hppa - basic_os=linux + basic_os=${basic_os:-linux} ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) cpu=i586 ;; - pentiumpro-* | p6-* | 6x86-* | athlon-* | athalon_*-*) + pentiumpro-* | p6-* | 6x86-* | athlon-* | athlon_*-*) cpu=i686 ;; pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) @@ -1071,9 +1158,6 @@ case $cpu-$vendor in pentium4-*) cpu=i786 ;; - pc98-*) - cpu=i386 - ;; ppc-* | ppcbe-*) cpu=powerpc ;; @@ -1107,13 +1191,10 @@ case $cpu-$vendor in tx39el-*) cpu=mipstx39el ;; - x64-*) - cpu=x86_64 - ;; xscale-* | xscalee[bl]-*) cpu=`echo "$cpu" | sed 's/^xscale/arm/'` ;; - arm64-*) + arm64-* | aarch64le-*) cpu=aarch64 ;; @@ -1165,114 +1246,231 @@ case $cpu-$vendor in # Recognize the canonical CPU types that are allowed with any # company name. case $cpu in - 1750a | 580 \ + 1750a \ + | 580 \ + | [cjt]90 \ | a29k \ - | aarch64 | aarch64_be \ + | aarch64 \ + | aarch64_be \ + | aarch64c \ | abacus \ - | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \ - | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \ - | alphapca5[67] | alpha64pca5[67] \ + | alpha \ + | alpha64 \ + | alpha64ev56 \ + | alpha64ev6[78] \ + | alpha64ev[4-8] \ + | alpha64pca5[67] \ + | alphaev56 \ + | alphaev6[78] \ + | alphaev[4-8] \ + | alphapca5[67] \ | am33_2.0 \ | amdgcn \ - | arc | arceb | arc32 | arc64 \ - | arm | arm[lb]e | arme[lb] | armv* \ - | avr | avr32 \ + | arc \ + | arc32 \ + | arc64 \ + | arceb \ + | arm \ + | arm64e \ + | arm64ec \ + | arm[lb]e \ + | arme[lb] \ + | armv* \ | asmjs \ + | avr \ + | avr32 \ | 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 \ + | be32 \ + | be64 \ + | bfin \ + | bpf \ + | bs2000 \ + | c30 \ + | c4x \ + | c8051 \ + | c[123]* \ + | clipper \ + | craynv \ + | csky \ + | cydra \ + | d10v \ + | d30v \ + | dlx \ + | dsp16xx \ + | e2k \ + | elxsi \ + | epiphany \ + | f30[01] \ + | f700 \ + | fido \ + | fr30 \ + | frv \ + | ft32 \ + | fx80 \ + | h8300 \ + | h8500 \ | hexagon \ - | i370 | i*86 | i860 | i960 | ia16 | ia64 \ - | ip2k | iq2000 \ + | hppa \ + | hppa1.[01] \ + | hppa2.0 \ + | hppa2.0[nw] \ + | hppa64 \ + | i*86 \ + | i370 \ + | i860 \ + | i960 \ + | ia16 \ + | ia64 \ + | ip2k \ + | iq2000 \ + | javascript \ | k1om \ - | le32 | le64 \ + | kvx \ + | 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 \ + | loongarch32 \ + | loongarch64 \ + | m32c \ + | m32r \ + | m32rle \ + | m5200 \ + | m68000 \ + | m680[012346]0 \ + | m6811 \ + | m6812 \ + | m68360 \ + | m683?2 \ + | m68hc11 \ + | m68hc12 \ + | m68hcs12x \ + | m68k \ + | m88110 \ + | m88k \ + | maxq \ + | mb \ + | mcore \ + | mep \ + | metag \ + | microblaze \ + | microblazeel \ + | mips* \ | mmix \ - | mn10200 | mn10300 \ + | mn10200 \ + | mn10300 \ | moxie \ - | mt \ | msp430 \ - | nds32 | nds32le | nds32be \ + | mt \ + | nanomips* \ + | nds32 \ + | nds32be \ + | nds32le \ | nfp \ - | nios | nios2 | nios2eb | nios2el \ - | none | np1 | ns16k | ns32k | nvptx \ + | nios \ + | nios2 \ + | nios2eb \ + | nios2el \ + | none \ + | np1 \ + | ns16k \ + | ns32k \ + | nvptx \ | open8 \ | or1k* \ | or32 \ | orion \ + | pdp10 \ + | pdp11 \ | picochip \ - | pdp10 | pdp11 | pj | pjl | pn | power \ - | powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \ + | pj \ + | pjl \ + | pn \ + | power \ + | powerpc \ + | powerpc64 \ + | powerpc64le \ + | powerpcle \ + | powerpcspe \ | pru \ | pyramid \ - | riscv | riscv32 | riscv32be | riscv64 | riscv64be \ - | rl78 | romp | rs6000 | rx \ - | s390 | s390x \ + | 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 \ + | sh \ + | sh64 \ + | sh64le \ + | sh[12345][lb]e \ + | sh[1234] \ + | sh[1234]e[lb] \ + | sh[23]e \ + | sh[23]ele \ + | sh[24]a \ + | sh[24]ae[lb] \ + | sh[lb]e \ + | she[lb] \ + | shl \ + | sparc \ + | sparc64 \ + | sparc64b \ + | sparc64v \ + | sparc86x \ + | sparclet \ | sparclite \ - | sparcv8 | sparcv9 | sparcv9b | sparcv9v | sv1 | sx* \ + | sparcv8 \ + | sparcv9 \ + | sparcv9b \ + | sparcv9v \ | spu \ + | sv1 \ + | sx* \ | tahoe \ | thumbv7* \ - | tic30 | tic4x | tic54x | tic55x | tic6x | tic80 \ + | tic30 \ + | tic4x \ + | tic54x \ + | tic55x \ + | tic6x \ + | tic80 \ | tron \ | ubicom32 \ - | v70 | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \ + | v70 \ + | v810 \ + | v850 \ + | v850e \ + | v850e1 \ + | v850e2 \ + | v850e2v3 \ + | v850es \ | vax \ + | vc4 \ | visium \ | w65 \ - | wasm32 | wasm64 \ + | wasm32 \ + | wasm64 \ | we32k \ - | x86 | x86_64 | xc16x | xgate | xps100 \ - | xstormy16 | xtensa* \ + | x86 \ + | x86_64 \ + | xc16x \ + | xgate \ + | xps100 \ + | xstormy16 \ + | xtensa* \ | ymp \ - | z8k | z80) + | z80 \ + | z8k) ;; *) - echo Invalid configuration \`"$1"\': machine \`"$cpu-$vendor"\' not recognized 1>&2 + echo "Invalid configuration '$1': machine '$cpu-$vendor' not recognized" 1>&2 exit 1 ;; esac @@ -1293,11 +1491,12 @@ esac # Decode manufacturer-specific aliases for certain operating systems. -if test x$basic_os != x +if test x"$basic_os" != x then -# First recognize some ad-hoc caes, or perhaps split kernel-os, or else just +# First recognize some ad-hoc cases, or perhaps split kernel-os, or else just # set os. +obj= case $basic_os in gnu/linux*) kernel=linux @@ -1312,10 +1511,11 @@ case $basic_os in os=`echo "$basic_os" | sed -e 's|nto-qnx|qnx|'` ;; *-*) - # shellcheck disable=SC2162 + saved_IFS=$IFS IFS="-" read kernel os <<EOF $basic_os EOF + IFS=$saved_IFS ;; # Default OS when just kernel was specified nto*) @@ -1326,6 +1526,10 @@ EOF kernel=linux os=`echo "$basic_os" | sed -e 's|linux|gnu|'` ;; + managarm*) + kernel=managarm + os=`echo "$basic_os" | sed -e 's|managarm|mlibc|'` + ;; *) kernel= os=$basic_os @@ -1353,6 +1557,23 @@ case $os in unixware*) os=sysv4.2uw ;; + # The marketing names for NeXT's operating systems were + # NeXTSTEP, NeXTSTEP 2, OpenSTEP 3, OpenSTEP 4. 'openstep' is + # mapped to 'openstep3', but 'openstep1' and 'openstep2' are + # mapped to 'nextstep' and 'nextstep2', consistent with the + # treatment of SunOS/Solaris. + ns | ns1 | nextstep | nextstep1 | openstep1) + os=nextstep + ;; + ns2 | nextstep2 | openstep2) + os=nextstep2 + ;; + ns3 | nextstep3 | openstep | openstep3) + os=openstep3 + ;; + ns4 | nextstep4 | openstep4) + os=openstep4 + ;; # es1800 is here to avoid being matched by es* (a different OS) es1800*) os=ose @@ -1423,6 +1644,7 @@ case $os in ;; utek*) os=bsd + vendor=`echo "$vendor" | sed -e 's|^unknown$|tektronix|'` ;; dynix*) os=bsd @@ -1439,21 +1661,25 @@ case $os in 386bsd) os=bsd ;; - ctix* | uts*) + ctix*) os=sysv + vendor=`echo "$vendor" | sed -e 's|^unknown$|convergent|'` ;; - nova*) - os=rtmk-nova + uts*) + os=sysv ;; - ns2) - os=nextstep2 + nova*) + kernel=rtmk + os=nova ;; # Preserve the version number of sinix5. sinix5.*) os=`echo "$os" | sed -e 's|sinix|sysv|'` + vendor=`echo "$vendor" | sed -e 's|^unknown$|sni|'` ;; sinix*) os=sysv4 + vendor=`echo "$vendor" | sed -e 's|^unknown$|sni|'` ;; tpf*) os=tpf @@ -1491,10 +1717,16 @@ case $os in os=eabi ;; *) - os=elf + os= + obj=elf ;; esac ;; + aout* | coff* | elf* | pe*) + # These are machine code file formats, not OSes + obj=$os + os= + ;; *) # No normalization, but not necessarily accepted, that comes below. ;; @@ -1513,12 +1745,15 @@ else # system, and we'll never get to this point. kernel= +obj= case $cpu-$vendor in score-*) - os=elf + os= + obj=elf ;; spu-*) - os=elf + os= + obj=elf ;; *-acorn) os=riscix1.2 @@ -1528,28 +1763,35 @@ case $cpu-$vendor in os=gnu ;; arm*-semi) - os=aout + os= + obj=aout ;; c4x-* | tic4x-*) - os=coff + os= + obj=coff ;; c8051-*) - os=elf + os= + obj=elf ;; clipper-intergraph) os=clix ;; hexagon-*) - os=elf + os= + obj=elf ;; tic54x-*) - os=coff + os= + obj=coff ;; tic55x-*) - os=coff + os= + obj=coff ;; tic6x-*) - os=coff + os= + obj=coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1571,28 +1813,43 @@ case $cpu-$vendor in os=sunos3 ;; m68*-cisco) - os=aout + os= + obj=aout ;; mep-*) - os=elf + os= + obj=elf + ;; + # The -sgi and -siemens entries must be before the mips- entry + # or we get the wrong os. + *-sgi) + os=irix + ;; + *-siemens) + os=sysv4 ;; mips*-cisco) - os=elf + os= + obj=elf ;; - mips*-*) - os=elf + mips*-*|nanomips*-*) + os= + obj=elf ;; or32-*) - os=coff + os= + obj=coff ;; - *-tti) # must be before sparc entry or we get the wrong os. + # This must be before the sparc-* entry or we get the wrong os. + *-tti) os=sysv3 ;; sparc-* | *-sun) os=sunos4.1.1 ;; pru-*) - os=elf + os= + obj=elf ;; *-be) os=beos @@ -1616,7 +1873,7 @@ case $cpu-$vendor in os=hpux ;; *-hitachi) - os=hiux + os=hiuxwe2 ;; i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) os=sysv @@ -1660,12 +1917,6 @@ case $cpu-$vendor in *-encore) os=bsd ;; - *-sgi) - os=irix - ;; - *-siemens) - os=sysv4 - ;; *-masscomp) os=rtu ;; @@ -1673,10 +1924,12 @@ case $cpu-$vendor in os=uxpv ;; *-rom68k) - os=coff + os= + obj=coff ;; *-*bug) - os=coff + os= + obj=coff ;; *-apple) os=macos @@ -1694,10 +1947,11 @@ esac fi -# Now, validate our (potentially fixed-up) OS. +# Now, validate our (potentially fixed-up) individual pieces (OS, OBJ). + case $os in # Sometimes we do "kernel-libc", so those need to count as OSes. - musl* | newlib* | uclibc*) + llvm* | musl* | newlib* | relibc* | uclibc*) ;; # Likewise for "kernel-abi" eabi* | gnueabi*) @@ -1705,81 +1959,308 @@ case $os in # VxWorks passes extra cpu info in the 4th filed. simlinux | simwindows | spe) ;; + # See `case $cpu-$os` validation below + ghcjs) + ;; # 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*) + abug \ + | aix* \ + | amdhsa* \ + | amigados* \ + | amigaos* \ + | android* \ + | aof* \ + | aos* \ + | aros* \ + | atheos* \ + | auroraux* \ + | aux* \ + | beos* \ + | bitrig* \ + | bme* \ + | bosx* \ + | bsd* \ + | cegcc* \ + | chorusos* \ + | chorusrdb* \ + | clix* \ + | cloudabi* \ + | cnk* \ + | conix* \ + | cos* \ + | cxux* \ + | cygwin* \ + | darwin* \ + | dgux* \ + | dicos* \ + | dnix* \ + | domain* \ + | dragonfly* \ + | drops* \ + | ebmon* \ + | ecoff* \ + | ekkobsd* \ + | emscripten* \ + | emx* \ + | es* \ + | fiwix* \ + | freebsd* \ + | fuchsia* \ + | genix* \ + | genode* \ + | glidix* \ + | gnu* \ + | go32* \ + | haiku* \ + | hcos* \ + | hiux* \ + | hms* \ + | hpux* \ + | ieee* \ + | interix* \ + | ios* \ + | iris* \ + | irix* \ + | ironclad* \ + | isc* \ + | its* \ + | l4re* \ + | libertybsd* \ + | lites* \ + | lnews* \ + | luna* \ + | lynxos* \ + | mach* \ + | macos* \ + | magic* \ + | mbr* \ + | midipix* \ + | midnightbsd* \ + | mingw32* \ + | mingw64* \ + | minix* \ + | mint* \ + | mirbsd* \ + | mks* \ + | mlibc* \ + | mmixware* \ + | mon960* \ + | morphos* \ + | moss* \ + | moxiebox* \ + | mpeix* \ + | mpw* \ + | msdos* \ + | msys* \ + | mvs* \ + | nacl* \ + | netbsd* \ + | netware* \ + | newsos* \ + | nextstep* \ + | nindy* \ + | nonstopux* \ + | nova* \ + | nsk* \ + | nucleus* \ + | nx6 \ + | nx7 \ + | oabi* \ + | ohos* \ + | onefs* \ + | openbsd* \ + | openedition* \ + | openstep* \ + | os108* \ + | os2* \ + | os400* \ + | os68k* \ + | os9* \ + | ose* \ + | osf* \ + | oskit* \ + | osx* \ + | palmos* \ + | phoenix* \ + | plan9* \ + | powermax* \ + | powerunix* \ + | proelf* \ + | psos* \ + | psp* \ + | ptx* \ + | pw32* \ + | qnx* \ + | rdos* \ + | redox* \ + | rhapsody* \ + | riscix* \ + | riscos* \ + | rtems* \ + | rtmk* \ + | rtu* \ + | scout* \ + | secbsd* \ + | sei* \ + | serenity* \ + | sim* \ + | skyos* \ + | solaris* \ + | solidbsd* \ + | sortix* \ + | storm-chaos* \ + | sunos \ + | sunos[34]* \ + | superux* \ + | syllable* \ + | sym* \ + | sysv* \ + | tenex* \ + | tirtos* \ + | toppers* \ + | tops10* \ + | tops20* \ + | tpf* \ + | tvos* \ + | twizzler* \ + | uclinux* \ + | udi* \ + | udk* \ + | ultrix* \ + | unicos* \ + | uniplus* \ + | unleashed* \ + | unos* \ + | uwin* \ + | uxpv* \ + | v88r* \ + |*vms* \ + | vos* \ + | vsta* \ + | vxsim* \ + | vxworks* \ + | wasi* \ + | watchos* \ + | wince* \ + | windiss* \ + | windows* \ + | winnt* \ + | xenix* \ + | xray* \ + | zephyr* \ + | zvmoe* ) ;; # 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. ;; + # This refers to builds using the UEFI calling convention + # (which depends on the architecture) and PE file format. + # Note that this is both a different calling convention and + # different file format than that of GNU-EFI + # (x86_64-w64-mingw32). + uefi) + ;; none) ;; + kernel* | msvc* ) + # Restricted further below + ;; + '') + if test x"$obj" = x + then + echo "Invalid configuration '$1': Blank OS only allowed with explicit machine code file format" 1>&2 + fi + ;; *) - echo Invalid configuration \`"$1"\': OS \`"$os"\' not recognized 1>&2 + echo "Invalid configuration '$1': OS '$os' not recognized" 1>&2 + exit 1 + ;; +esac + +case $obj in + aout* | coff* | elf* | pe*) + ;; + '') + # empty is fine + ;; + *) + echo "Invalid configuration '$1': Machine code format '$obj' not recognized" 1>&2 + exit 1 + ;; +esac + +# Here we handle the constraint that a (synthetic) cpu and os are +# valid only in combination with each other and nowhere else. +case $cpu-$os in + # The "javascript-unknown-ghcjs" triple is used by GHC; we + # accept it here in order to tolerate that, but reject any + # variations. + javascript-ghcjs) + ;; + javascript-* | *-ghcjs) + echo "Invalid configuration '$1': cpu '$cpu' is not valid with os '$os$obj'" 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* ) +case $kernel-$os-$obj in + linux-gnu*- | linux-android*- | linux-dietlibc*- | linux-llvm*- \ + | linux-mlibc*- | linux-musl*- | linux-newlib*- \ + | linux-relibc*- | linux-uclibc*- | linux-ohos*- ) ;; - uclinux-uclibc* ) + uclinux-uclibc*- | uclinux-gnu*- ) ;; - -dietlibc* | -newlib* | -musl* | -uclibc* ) + managarm-mlibc*- | managarm-kernel*- ) + ;; + windows*-msvc*-) + ;; + -dietlibc*- | -llvm*- | -mlibc*- | -musl*- | -newlib*- | -relibc*- \ + | -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 + echo "Invalid configuration '$1': libc '$os' needs explicit kernel." 1>&2 exit 1 ;; - kfreebsd*-gnu* | kopensolaris*-gnu*) + -kernel*- ) + echo "Invalid configuration '$1': '$os' needs explicit kernel." 1>&2 + exit 1 ;; - vxworks-simlinux | vxworks-simwindows | vxworks-spe) + *-kernel*- ) + echo "Invalid configuration '$1': '$kernel' does not support '$os'." 1>&2 + exit 1 ;; - nto-qnx*) + *-msvc*- ) + echo "Invalid configuration '$1': '$os' needs 'windows'." 1>&2 + exit 1 ;; - os2-emx) + kfreebsd*-gnu*- | knetbsd*-gnu*- | netbsd*-gnu*- | kopensolaris*-gnu*-) + ;; + vxworks-simlinux- | vxworks-simwindows- | vxworks-spe-) + ;; + nto-qnx*-) ;; - *-eabi* | *-gnueabi*) + os2-emx-) ;; - -*) + rtmk-nova-) + ;; + *-eabi*- | *-gnueabi*-) + ;; + none--*) + # None (no kernel, i.e. freestanding / bare metal), + # can be paired with an machine code file format + ;; + -*-) # Blank kernel with real OS is always fine. ;; - *-*) - echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2 + --*) + # Blank kernel and OS with real machine code file format is always fine. + ;; + *-*-*) + echo "Invalid configuration '$1': Kernel '$kernel' not known to work with OS '$os'." 1>&2 exit 1 ;; esac @@ -1792,7 +2273,7 @@ case $vendor in *-riscix*) vendor=acorn ;; - *-sunos*) + *-sunos* | *-solaris*) vendor=sun ;; *-cnk* | *-aix*) @@ -1862,7 +2343,7 @@ case $vendor in ;; esac -echo "$cpu-$vendor-${kernel:+$kernel-}$os" +echo "$cpu-$vendor${kernel:+-$kernel}${os:+-$os}${obj:+-$obj}" exit # Local variables: diff --git a/autosetup/autosetup-find-tclsh b/autosetup/autosetup-find-tclsh index 0029f17..f0fd98c 100755 --- a/autosetup/autosetup-find-tclsh +++ b/autosetup/autosetup-find-tclsh @@ -9,7 +9,7 @@ for tclsh in ./jimsh0 $autosetup_tclsh jimsh tclsh tclsh8.5 tclsh8.6 tclsh8.7; d done echo 1>&2 "No installed jimsh or tclsh, building local bootstrap jimsh0" for cc in ${CC_FOR_BUILD:-cc} gcc; do - { $cc -o jimsh0 "$d/jimsh0.c"; } 2>/dev/null || continue + { $cc -o jimsh0 "$d/jimsh0.c"; } 2>&1 >/dev/null || continue ./jimsh0 "$d/${1-autosetup-test-tclsh}" && exit 0 done echo 1>&2 "No working C compiler found. Tried ${CC_FOR_BUILD:-cc} and gcc." diff --git a/autosetup/cc.tcl b/autosetup/cc.tcl index f45cc2e..05c1b1c 100644 --- a/autosetup/cc.tcl +++ b/autosetup/cc.tcl @@ -5,7 +5,7 @@ # # The 'cc' module supports checking various 'features' of the C or C++ # compiler/linker environment. Common commands are 'cc-check-includes', -# 'cc-check-types', 'cc-check-functions', 'cc-with', 'make-config-header' and 'make-template'. +# 'cc-check-types', 'cc-check-functions', 'cc-with' and 'make-config-header' # # The following environment variables are used if set: # @@ -677,80 +677,82 @@ proc calc-define-output-type {name spec} { return "" } -# Initialise some values from the environment or commandline or default settings -foreach i {LDFLAGS LIBS CPPFLAGS LINKFLAGS CFLAGS} { - lassign $i var default - define $var [get-env $var $default] -} +proc cc-init {} { + global autosetup -if {[env-is-set CC]} { - # Set by the user, so don't try anything else - set try [list [get-env CC ""]] -} else { - # Try some reasonable options - set try [list [get-define cross]cc [get-define cross]gcc] -} -define CC [find-an-executable {*}$try] -if {[get-define CC] eq ""} { - user-error "Could not find a C compiler. Tried: [join $try ", "]" -} + # Initialise some values from the environment or commandline or default settings + foreach i {LDFLAGS LIBS CPPFLAGS LINKFLAGS CFLAGS} { + lassign $i var default + define $var [get-env $var $default] + } -define CPP [get-env CPP "[get-define CC] -E"] + if {[env-is-set CC]} { + # Set by the user, so don't try anything else + set try [list [get-env CC ""]] + } else { + # Try some reasonable options + set try [list [get-define cross]cc [get-define cross]gcc] + } + define CC [find-an-executable {*}$try] + if {[get-define CC] eq ""} { + user-error "Could not find a C compiler. Tried: [join $try ", "]" + } -# XXX: Could avoid looking for a C++ compiler until requested -# 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++] -} + define CPP [get-env CPP "[get-define CC] -E"] -# CXXFLAGS default to CFLAGS if not specified -define CXXFLAGS [get-env CXXFLAGS [get-define CFLAGS]] + # XXX: Could avoid looking for a C++ compiler until requested + # 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++] + } -# May need a CC_FOR_BUILD, so look for one -define CC_FOR_BUILD [find-an-executable [get-env CC_FOR_BUILD ""] cc gcc false] + # CXXFLAGS default to CFLAGS if not specified + define CXXFLAGS [get-env CXXFLAGS [get-define CFLAGS]] -if {[get-define CC] eq ""} { - user-error "Could not find a C compiler. Tried: [join $try ", "]" -} + # May need a CC_FOR_BUILD, so look for one + define CC_FOR_BUILD [find-an-executable [get-env CC_FOR_BUILD ""] cc gcc false] -# These start empty and never come from the user or environment -define AS_CFLAGS "" -define AS_CPPFLAGS "" -define AS_CXXFLAGS "" + # These start empty and never come from the user or environment + define AS_CFLAGS "" + define AS_CPPFLAGS "" + define AS_CXXFLAGS "" -define CCACHE [find-an-executable [get-env CCACHE ccache]] + define CCACHE [find-an-executable [get-env CCACHE ccache]] -# If any of these are set in the environment, propagate them to the AUTOREMAKE commandline -foreach i {CC CXX CCACHE CPP CFLAGS CXXFLAGS CXXFLAGS LDFLAGS LIBS CROSS CPPFLAGS LINKFLAGS CC_FOR_BUILD LD} { - if {[env-is-set $i]} { - # Note: If the variable is set on the command line, get-env will return that value - # so the command line will continue to override the environment - define-append-argv AUTOREMAKE $i=[get-env $i ""] + # If any of these are set in the environment, propagate them to the AUTOREMAKE commandline + foreach i {CC CXX CCACHE CPP CFLAGS CXXFLAGS CXXFLAGS LDFLAGS LIBS CROSS CPPFLAGS LINKFLAGS CC_FOR_BUILD LD} { + if {[env-is-set $i]} { + # Note: If the variable is set on the command line, get-env will return that value + # so the command line will continue to override the environment + define-append-argv AUTOREMAKE $i=[get-env $i ""] + } } -} -# Initial cctest settings -cc-store-settings {-cflags {} -includes {} -declare {} -link 0 -lang c -libs {} -code {} -nooutput 0} -set autosetup(cc-include-deps) {} + # Initial cctest settings + cc-store-settings {-cflags {} -includes {} -declare {} -link 0 -lang c -libs {} -code {} -nooutput 0} + set autosetup(cc-include-deps) {} -msg-result "C compiler...[get-define CCACHE] [get-define CC] [get-define CFLAGS] [get-define CPPFLAGS]" -if {[get-define CXX] ne "false"} { - msg-result "C++ compiler...[get-define CCACHE] [get-define CXX] [get-define CXXFLAGS] [get-define CPPFLAGS]" -} -msg-result "Build C compiler...[get-define CC_FOR_BUILD]" - -# On Darwin, we prefer to use -g0 to avoid creating .dSYM directories -# but some compilers may not support it, so test here. -switch -glob -- [get-define host] { - *-*-darwin* { - if {[cctest -cflags {-g0}]} { - define cc-default-debug -g0 + msg-result "C compiler...[get-define CCACHE] [get-define CC] [get-define CFLAGS] [get-define CPPFLAGS]" + if {[get-define CXX] ne "false"} { + msg-result "C++ compiler...[get-define CCACHE] [get-define CXX] [get-define CXXFLAGS] [get-define CPPFLAGS]" + } + msg-result "Build C compiler...[get-define CC_FOR_BUILD]" + + # On Darwin, we prefer to use -g0 to avoid creating .dSYM directories + # but some compilers may not support it, so test here. + switch -glob -- [get-define host] { + *-*-darwin* { + if {[cctest -cflags {-g0}]} { + define cc-default-debug -g0 + } } } -} -if {![cc-check-includes stdlib.h]} { - user-error "Compiler does not work. See config.log" + if {![cc-check-includes stdlib.h]} { + user-error "Compiler does not work. See config.log" + } } + +cc-init diff --git a/autosetup/jimsh0.c b/autosetup/jimsh0.c index f3ec997..8f6f7ea 100644 --- a/autosetup/jimsh0.c +++ b/autosetup/jimsh0.c @@ -1,8 +1,9 @@ /* This is single source file, bootstrap version of Jim Tcl. See http://jim.tcl.tk/ */ -#define JIM_TCL_COMPAT +#define JIM_COMPAT #define JIM_ANSIC #define JIM_REGEXP #define HAVE_NO_AUTOCONF +#define JIM_TINY #define _JIMAUTOCONF_H #define TCL_LIBRARY "." #define jim_ext_bootstrap @@ -12,7 +13,6 @@ #define jim_ext_file #define jim_ext_glob #define jim_ext_exec -#define jim_ext_posix #define jim_ext_clock #define jim_ext_array #define jim_ext_stdlib @@ -62,7 +62,7 @@ #define HAVE_PIPE #define _FILE_OFFSET_BITS 64 #endif -#define JIM_VERSION 82 +#define JIM_VERSION 84 #ifndef JIM_WIN32COMPAT_H #define JIM_WIN32COMPAT_H @@ -95,6 +95,9 @@ char *dlerror(void); #include <limits.h> #define jim_wide _int64 +#ifndef HAVE_LONG_LONG +#define HAVE_LONG_LONG +#endif #ifndef LLONG_MAX #define LLONG_MAX 9223372036854775807I64 #endif @@ -109,11 +112,7 @@ char *dlerror(void); #include <io.h> -struct timeval { - long tv_sec; - long tv_usec; -}; - +#include <winsock.h> int gettimeofday(struct timeval *tv, void *unused); #define HAVE_OPENDIR @@ -576,7 +575,7 @@ typedef struct Jim_Interp { Jim_Obj *result; int unused_errorLine; Jim_Obj *currentFilenameObj; - int unused_addStackTrace; + int break_level; int maxCallFrameDepth; int maxEvalDepth; int evalDepth; @@ -720,6 +719,14 @@ JIM_EXPORT int Jim_SubstObj (Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags); +JIM_EXPORT Jim_Obj *Jim_GetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, + int *lineptr); + +JIM_EXPORT void Jim_SetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *fileNameObj, int lineNumber); + + + JIM_EXPORT void Jim_InitStack(Jim_Stack *stack); JIM_EXPORT void Jim_FreeStack(Jim_Stack *stack); JIM_EXPORT int Jim_StackLen(Jim_Stack *stack); @@ -1155,7 +1162,7 @@ int Jim_OpenForWrite(const char *filename, int append); int Jim_OpenForRead(const char *filename); -#if defined(__MINGW32__) +#if defined(__MINGW32__) || defined(_WIN32) #ifndef STRICT #define STRICT #endif @@ -1190,6 +1197,7 @@ int Jim_OpenForRead(const char *filename); #define Jim_Stat _stat64 #define Jim_FileStat _fstat64 #define Jim_Lseek _lseeki64 + #define O_TEXT _O_TEXT #else #if defined(HAVE_STAT64) @@ -1232,10 +1240,11 @@ int Jim_OpenForRead(const char *filename); #define execvpe(ARG0, ARGV, ENV) execvp(ARG0, ARGV) #endif #endif -#endif -#ifndef O_TEXT -#define O_TEXT 0 + #ifndef O_TEXT + #define O_TEXT 0 + #endif + #endif @@ -1284,8 +1293,14 @@ int Jim_initjimshInit(Jim_Interp *interp) " 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" +" set jim::argv0 [file tail $jim::argv0]\n" +" set path [split [env PATH \"\"] $tcl_platform(pathSeparator)]\n" +" if {$tcl_platform(platform) eq \"windows\"} {\n" +"\n" +" set path [lmap p [list \"\" {*}$path] { string map {\\\\ /} $p }]\n" +" }\n" +" foreach p $path {\n" +" set exec [file join [pwd] $p $jim::argv0]\n" " if {[file executable $exec]} {\n" " set jim::exe $exec\n" " break\n" @@ -1938,9 +1953,6 @@ int Jim_tclcompatInit(Jim_Interp *interp) " 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" @@ -2040,8 +2052,8 @@ int Jim_tclcompatInit(Jim_Interp *interp) #define AIO_CMD_LEN 32 -#define AIO_BUF_LEN 256 -#define AIO_WBUF_FULL_SIZE (64 * 1024) +#define AIO_DEFAULT_RBUF_LEN 256 +#define AIO_DEFAULT_WBUF_LIMIT (64 * 1024) #define AIO_KEEPOPEN 1 #define AIO_NODELETE 2 @@ -2049,6 +2061,8 @@ int Jim_tclcompatInit(Jim_Interp *interp) #define AIO_WBUF_NONE 8 #define AIO_NONBLOCK 16 +#define AIO_ONEREAD 32 + enum wbuftype { WBUF_OPT_NONE, WBUF_OPT_LINE, @@ -2123,11 +2137,20 @@ typedef struct AioFile const JimAioFopsType *fops; Jim_Obj *readbuf; Jim_Obj *writebuf; + char *rbuf; + size_t rbuf_len; + size_t wbuf_limit; } AioFile; +static void aio_consume(Jim_Obj *objPtr, int n); + static int stdio_writer(struct AioFile *af, const char *buf, int len) { - return write(af->fd, buf, len); + int ret = write(af->fd, buf, len); + if (ret < 0 && errno == EPIPE) { + aio_consume(af->writebuf, Jim_Length(af->writebuf)); + } + return ret; } static int stdio_reader(struct AioFile *af, char *buf, int len, int nb) @@ -2264,7 +2287,22 @@ static void aio_consume(Jim_Obj *objPtr, int n) } -static int aio_autoflush(Jim_Interp *interp, void *clientData, int mask); +static int aio_flush(Jim_Interp *interp, AioFile *af); + +#ifdef jim_ext_eventloop +static int aio_autoflush(Jim_Interp *interp, void *clientData, int mask) +{ + AioFile *af = clientData; + + aio_flush(interp, af); + if (Jim_Length(af->writebuf) == 0) { + + return -1; + } + return 0; +} +#endif + static int aio_flush(Jim_Interp *interp, AioFile *af) { @@ -2299,19 +2337,7 @@ static int aio_flush(Jim_Interp *interp, AioFile *af) return JIM_OK; } -static int aio_autoflush(Jim_Interp *interp, void *clientData, int mask) -{ - AioFile *af = clientData; - - aio_flush(interp, af); - if (Jim_Length(af->writebuf) == 0) { - - return -1; - } - return 0; -} - -static int aio_read_len(Jim_Interp *interp, AioFile *af, int nb, char *buf, size_t buflen, int neededLen) +static int aio_read_len(Jim_Interp *interp, AioFile *af, unsigned flags, int neededLen) { if (!af->readbuf) { af->readbuf = Jim_NewStringObj(interp, NULL, 0); @@ -2329,25 +2355,32 @@ static int aio_read_len(Jim_Interp *interp, AioFile *af, int nb, char *buf, size int readlen; if (neededLen == -1) { - readlen = AIO_BUF_LEN; + readlen = af->rbuf_len; } else { - readlen = (neededLen > AIO_BUF_LEN ? AIO_BUF_LEN : neededLen); + readlen = (neededLen > af->rbuf_len ? af->rbuf_len : neededLen); + } + + if (!af->rbuf) { + af->rbuf = Jim_Alloc(af->rbuf_len); } - retval = af->fops->reader(af, buf, readlen, nb); + retval = af->fops->reader(af, af->rbuf, readlen, flags & AIO_NONBLOCK); if (retval > 0) { - Jim_AppendString(interp, af->readbuf, buf, retval); + if (retval) { + Jim_AppendString(interp, af->readbuf, af->rbuf, retval); + } if (neededLen != -1) { neededLen -= retval; } + if (flags & AIO_ONEREAD) { + return JIM_OK; + } continue; } - if (JimCheckStreamError(interp, af)) { + if ((flags & AIO_ONEREAD) || JimCheckStreamError(interp, af)) { return JIM_ERR; } - if (nb || af->timeout) { - return JIM_OK; - } + break; } return JIM_OK; @@ -2415,6 +2448,7 @@ static void JimAioDelProc(Jim_Interp *interp, void *privData) Jim_FreeNewObj(interp, af->readbuf); } + Jim_Free(af->rbuf); Jim_Free(af); } @@ -2428,7 +2462,6 @@ static int aio_cmd_read(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int option; int nb; Jim_Obj *objPtr; - char buf[AIO_BUF_LEN]; if (argc) { if (*Jim_String(argv[0]) == '-') { @@ -2462,7 +2495,7 @@ static int aio_cmd_read(Jim_Interp *interp, int argc, Jim_Obj *const *argv) nb = aio_start_nonblocking(af); - if (aio_read_len(interp, af, nb, buf, sizeof(buf), neededLen) != JIM_OK) { + if (aio_read_len(interp, af, nb ? AIO_NONBLOCK : 0, neededLen) != JIM_OK) { aio_set_nonblocking(af, nb); return JIM_ERR; } @@ -2517,11 +2550,6 @@ 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; - - char buf[AIO_BUF_LEN]; - - char *bufp = buf; - int buflen = sizeof(buf); int ok = 1; Jim_Obj *objv[4]; @@ -2547,10 +2575,10 @@ static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) while (count < maxlen) { jim_wide len = maxlen - count; - if (len > buflen) { - len = buflen; + if (len > af->rbuf_len) { + len = af->rbuf_len; } - if (aio_read_len(interp, af, 0, bufp, buflen, len) != JIM_OK) { + if (aio_read_len(interp, af, 0, len) != JIM_OK) { ok = 0; break; } @@ -2563,17 +2591,13 @@ static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) if (aio_eof(af)) { break; } - if (count >= 16384 && bufp == buf) { + if (count >= 16384 && af->rbuf_len < 65536) { - buflen = 65536; - bufp = Jim_Alloc(buflen); + af->rbuf_len = 65536; + af->rbuf = Jim_Realloc(af->rbuf, af->rbuf_len); } } - if (bufp != buf) { - Jim_Free(bufp); - } - Jim_DecrRefCount(interp, objv[1]); Jim_DecrRefCount(interp, objv[2]); @@ -2589,10 +2613,10 @@ static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) 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 = NULL; int len; int nb; + unsigned flags = AIO_ONEREAD; char *nl = NULL; int offset = 0; @@ -2600,38 +2624,33 @@ static int aio_cmd_gets(Jim_Interp *interp, int argc, Jim_Obj *const *argv) nb = aio_start_nonblocking(af); - - if (!af->readbuf) { - af->readbuf = Jim_NewStringObj(interp, NULL, 0); + if (nb) { + flags |= AIO_NONBLOCK; } while (!aio_eof(af)) { - const char *pt = Jim_GetString(af->readbuf, &len); - nl = memchr(pt + offset, '\n', len - offset); - if (nl) { + if (af->readbuf) { + const char *pt = Jim_GetString(af->readbuf, &len); + nl = memchr(pt + offset, '\n', len - offset); + if (nl) { - objPtr = Jim_NewStringObj(interp, pt, nl - pt); - - aio_consume(af->readbuf, nl - pt + 1); - break; - } - - offset = len; - len = af->fops->reader(af, buf, AIO_BUF_LEN, nb); - if (len <= 0) { - if (nb || af->timeout) { + objPtr = Jim_NewStringObj(interp, pt, nl - pt); + aio_consume(af->readbuf, nl - pt + 1); break; } + offset = len; } - else { - Jim_AppendString(interp, af->readbuf, buf, len); + + + if (aio_read_len(interp, af, flags, -1) != JIM_OK) { + break; } } aio_set_nonblocking(af, nb); - if (!nl && aio_eof(af)) { + if (!nl && aio_eof(af) && af->readbuf) { objPtr = af->readbuf; af->readbuf = NULL; @@ -2680,6 +2699,13 @@ static int aio_cmd_puts(Jim_Interp *interp, int argc, Jim_Obj *const *argv) strObj = argv[0]; } +#ifdef JIM_MAINTAINER + if (Jim_IsShared(af->writebuf)) { + Jim_DecrRefCount(interp, af->writebuf); + af->writebuf = Jim_DuplicateObj(interp, af->writebuf); + Jim_IncrRefCount(af->writebuf); + } +#endif Jim_AppendObj(interp, af->writebuf, strObj); if (nl) { Jim_AppendString(interp, af->writebuf, "\n", 1); @@ -2701,7 +2727,7 @@ static int aio_cmd_puts(Jim_Interp *interp, int argc, Jim_Obj *const *argv) break; case WBUF_OPT_FULL: - if (wlen >= AIO_WBUF_FULL_SIZE) { + if (wlen >= af->wbuf_limit) { wnow = 1; } break; @@ -2870,6 +2896,7 @@ static int aio_cmd_sync(Jim_Interp *interp, int argc, Jim_Obj *const *argv) static int aio_cmd_buffering(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { AioFile *af = Jim_CmdPrivData(interp); + Jim_Obj *resultObj; static const char * const options[] = { "none", @@ -2878,17 +2905,57 @@ static int aio_cmd_buffering(Jim_Interp *interp, int argc, Jim_Obj *const *argv) NULL }; - if (Jim_GetEnum(interp, argv[0], options, &af->wbuft, NULL, JIM_ERRMSG) != JIM_OK) { - return JIM_ERR; + if (argc) { + if (Jim_GetEnum(interp, argv[0], options, &af->wbuft, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + + if (af->wbuft == WBUF_OPT_FULL && argc == 2) { + long l; + if (Jim_GetLong(interp, argv[1], &l) != JIM_OK || l <= 0) { + return JIM_ERR; + } + af->wbuf_limit = l; + } + + if (af->wbuft == WBUF_OPT_NONE) { + if (aio_flush(interp, af) != JIM_OK) { + return JIM_ERR; + } + } + } - if (af->wbuft == WBUF_OPT_NONE) { - return aio_flush(interp, af); + resultObj = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, resultObj, Jim_NewStringObj(interp, options[af->wbuft], -1)); + if (af->wbuft == WBUF_OPT_FULL) { + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, af->wbuf_limit)); } + Jim_SetResult(interp, resultObj); return JIM_OK; } +static int aio_cmd_readsize(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + if (argc) { + long l; + if (Jim_GetLong(interp, argv[0], &l) != JIM_OK || l <= 0) { + return JIM_ERR; + } + af->rbuf_len = l; + if (af->rbuf) { + af->rbuf = Jim_Realloc(af->rbuf, af->rbuf_len); + } + } + Jim_SetResultInt(interp, af->rbuf_len); + + return JIM_OK; +} + +#ifdef jim_ext_eventloop static int aio_cmd_timeout(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { #ifdef HAVE_SELECT @@ -2906,7 +2973,6 @@ static int aio_cmd_timeout(Jim_Interp *interp, int argc, Jim_Obj *const *argv) #endif } -#ifdef jim_ext_eventloop static int aio_eventinfo(Jim_Interp *interp, AioFile * af, unsigned mask, int argc, Jim_Obj * const *argv) { @@ -3074,9 +3140,16 @@ static const jim_subcmd_type aio_command_table[] = { }, #endif { "buffering", - "none|line|full", + "?none|line|full? ?size?", aio_cmd_buffering, - 1, + 0, + 2, + + }, + { "readsize", + "?size?", + aio_cmd_readsize, + 0, 1, }, @@ -3319,6 +3392,9 @@ static AioFile *JimMakeChannel(Jim_Interp *interp, int fd, Jim_Obj *filename, af->writebuf = Jim_NewStringObj(interp, NULL, 0); Jim_IncrRefCount(af->writebuf); + af->wbuf_limit = AIO_DEFAULT_WBUF_LIMIT; + af->rbuf_len = AIO_DEFAULT_RBUF_LEN; + Jim_CreateCommand(interp, buf, JimAioSubCmdProc, af, JimAioDelProc); @@ -3772,27 +3848,30 @@ 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 opt_command = 0; int offset = 0; regex_t *regex; const char *p; - int result; + int result = JIM_OK; regmatch_t pmatch[MAX_SUB_MATCHES + 1]; int num_matches = 0; int i, j, n; Jim_Obj *varname; Jim_Obj *resultObj; + Jim_Obj *cmd_prefix = NULL; + Jim_Obj *regcomp_obj = NULL; const char *source_str; int source_len; - const char *replace_str; + const char *replace_str = NULL; int replace_len; const char *pattern; int option; enum { - OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_START, OPT_END + OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_START, OPT_COMMAND, OPT_END }; static const char * const options[] = { - "-nocase", "-line", "-all", "-start", "--", NULL + "-nocase", "-line", "-all", "-start", "-command", "--", NULL }; if (argc < 4) { @@ -3836,20 +3915,39 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_ERR; } break; + + case OPT_COMMAND: + opt_command = 1; + break; } } if (argc - i != 3 && argc - i != 4) { goto wrongNumArgs; } - regex = SetRegexpFromAny(interp, argv[i], regcomp_flags); + + regcomp_obj = Jim_DuplicateObj(interp, argv[i]); + Jim_IncrRefCount(regcomp_obj); + regex = SetRegexpFromAny(interp, regcomp_obj, regcomp_flags); if (!regex) { + Jim_DecrRefCount(interp, regcomp_obj); 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); + if (opt_command) { + cmd_prefix = argv[i + 2]; + if (Jim_ListLength(interp, cmd_prefix) == 0) { + Jim_SetResultString(interp, "command prefix must be a list of at least one element", -1); + Jim_DecrRefCount(interp, regcomp_obj); + return JIM_ERR; + } + Jim_IncrRefCount(cmd_prefix); + } + else { + replace_str = Jim_GetString(argv[i + 2], &replace_len); + } varname = argv[i + 3]; @@ -3893,35 +3991,58 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_AppendString(interp, resultObj, p, pmatch[0].rm_so); + if (opt_command) { - for (j = 0; j < replace_len; j++) { - int idx; - int c = replace_str[j]; + Jim_Obj *cmdListObj = Jim_DuplicateObj(interp, cmd_prefix); + for (j = 0; j < MAX_SUB_MATCHES; j++) { + if (pmatch[j].rm_so == -1) { + break; + } + else { + Jim_Obj *srcObj = Jim_NewStringObj(interp, p + pmatch[j].rm_so, pmatch[j].rm_eo - pmatch[j].rm_so); + Jim_ListAppendElement(interp, cmdListObj, srcObj); + } + } + Jim_IncrRefCount(cmdListObj); - if (c == '&') { - idx = 0; + result = Jim_EvalObj(interp, cmdListObj); + Jim_DecrRefCount(interp, cmdListObj); + if (result != JIM_OK) { + goto cmd_error; } - else if (c == '\\' && j < replace_len) { - c = replace_str[++j]; - if ((c >= '0') && (c <= '9')) { - idx = c - '0'; + Jim_AppendString(interp, resultObj, Jim_String(Jim_GetResult(interp)), -1); + } + else { + + for (j = 0; j < replace_len; j++) { + int idx; + int c = replace_str[j]; + + if (c == '&') { + idx = 0; } - else if ((c == '\\') || (c == '&')) { - Jim_AppendString(interp, resultObj, replace_str + j, 1); - continue; + 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, (j == replace_len) ? 1 : 2); + Jim_AppendString(interp, resultObj, replace_str + j, 1); 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); + 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); + } } } @@ -3958,22 +4079,34 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_AppendString(interp, resultObj, p, -1); +cmd_error: + if (result == JIM_OK) { - if (argc - i == 4) { - result = Jim_SetVariable(interp, varname, resultObj); + if (argc - i == 4) { + result = Jim_SetVariable(interp, varname, resultObj); - if (result == JIM_OK) { - Jim_SetResultInt(interp, num_matches); + if (result == JIM_OK) { + Jim_SetResultInt(interp, num_matches); + } + else { + Jim_FreeObj(interp, resultObj); + } } else { - Jim_FreeObj(interp, resultObj); + Jim_SetResult(interp, resultObj); + result = JIM_OK; } } else { - Jim_SetResult(interp, resultObj); - result = JIM_OK; + Jim_FreeObj(interp, resultObj); + } + + if (opt_command) { + Jim_DecrRefCount(interp, cmd_prefix); } + Jim_DecrRefCount(interp, regcomp_obj); + return result; } @@ -6355,6 +6488,7 @@ static int clock_cmd_scan(Jim_Interp *interp, int argc, Jim_Obj *const *argv) } + tm.tm_isdst = options.gmt ? 0 : -1; Jim_SetResultInt(interp, options.gmt ? jim_timegm(&tm) : mktime(&tm)); return JIM_OK; @@ -6659,53 +6793,6 @@ int Jim_arrayInit(Jim_Interp *interp) Jim_CreateCommand(interp, "array", Jim_SubCmdProc, (void *)array_command_table, NULL); return JIM_OK; } - -#include <sys/types.h> -#include <sys/time.h> -#include <sys/wait.h> -#include <unistd.h> -#include <string.h> -#include <errno.h> - - -#ifdef HAVE_SYS_SYSINFO_H -#include <sys/sysinfo.h> -#endif - -static void Jim_PosixSetError(Jim_Interp *interp) -{ - Jim_SetResultString(interp, strerror(errno), -1); -} - -#if defined(HAVE_FORK) -static int Jim_PosixForkCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) -{ - pid_t pid; - - JIM_NOTUSED(argv); - - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } - if ((pid = fork()) == -1) { - Jim_PosixSetError(interp); - return JIM_ERR; - } - Jim_SetResultInt(interp, (jim_wide) pid); - return JIM_OK; -} -#endif - - -int Jim_posixInit(Jim_Interp *interp) -{ - Jim_PackageProvideCheck(interp, "posix"); -#ifdef HAVE_FORK - Jim_CreateCommand(interp, "os.fork", Jim_PosixForkCommand, NULL, NULL); -#endif - return JIM_OK; -} int Jim_InitStaticExtensions(Jim_Interp *interp) { extern int Jim_bootstrapInit(Jim_Interp *); @@ -6715,7 +6802,6 @@ 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_posixInit(Jim_Interp *); extern int Jim_clockInit(Jim_Interp *); extern int Jim_arrayInit(Jim_Interp *); extern int Jim_stdlibInit(Jim_Interp *); @@ -6727,14 +6813,15 @@ Jim_regexpInit(interp); Jim_fileInit(interp); Jim_globInit(interp); Jim_execInit(interp); -Jim_posixInit(interp); Jim_clockInit(interp); Jim_arrayInit(interp); Jim_stdlibInit(interp); Jim_tclcompatInit(interp); return JIM_OK; } +#ifndef JIM_TINY #define JIM_OPTIMIZATION +#endif #include <stdio.h> #include <stdlib.h> @@ -6794,7 +6881,9 @@ return JIM_OK; #define JIM_INTEGER_SPACE 24 -const char *jim_tt_name(int type); +#if defined(DEBUG_SHOW_SCRIPT) || defined(DEBUG_SHOW_SCRIPT_TOKENS) || defined(JIM_DEBUG_COMMAND) || defined(DEBUG_SHOW_SUBST) +static const char *jim_tt_name(int type); +#endif #ifdef JIM_DEBUG_PANIC static void JimPanicDump(int fail_condition, const char *fmt, ...); @@ -6830,7 +6919,6 @@ 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_VarVal *vv); static Jim_VarVal *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr); -static void JimSetErrorStack(Jim_Interp *interp); static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); #define JIM_DICT_SUGAR 100 @@ -7809,6 +7897,7 @@ struct JimParserCtx int inquote; int comment; struct JimParseMissing missing; + const char *errmsg; }; static int JimParseScript(struct JimParserCtx *pc); @@ -9509,17 +9598,6 @@ void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) 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, @@ -9580,6 +9658,7 @@ typedef struct 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); +static void JimSetErrorStack(Jim_Interp *interp, ScriptObj *script); void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) { @@ -9795,7 +9874,7 @@ static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script, token->objPtr = JimMakeScriptObj(interp, t); Jim_IncrRefCount(token->objPtr); - JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line); + Jim_SetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line); token++; } } @@ -9855,6 +9934,39 @@ static int JimParseCheckMissing(Jim_Interp *interp, int ch) return JIM_ERR; } +Jim_Obj *Jim_GetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, int *lineptr) +{ + int line; + Jim_Obj *fileNameObj; + + if (objPtr->typePtr == &sourceObjType) { + fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; + line = objPtr->internalRep.sourceValue.lineNumber; + } + else if (objPtr->typePtr == &scriptObjType) { + ScriptObj *script = JimGetScript(interp, objPtr); + fileNameObj = script->fileNameObj; + line = script->firstline; + } + else { + fileNameObj = interp->emptyObj; + line = 1; + } + *lineptr = line; + return fileNameObj; +} + +void Jim_SetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *fileNameObj, int lineNumber) +{ + JimPanic((Jim_IsShared(objPtr), "Jim_SetSourceInfo called with shared object")); + Jim_FreeIntRep(interp, objPtr); + Jim_IncrRefCount(fileNameObj); + objPtr->internalRep.sourceValue.fileNameObj = fileNameObj; + objPtr->internalRep.sourceValue.lineNumber = lineNumber; + objPtr->typePtr = &sourceObjType; +} + static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script, ParseTokenList *tokenlist) { @@ -9883,12 +9995,11 @@ static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) struct JimParserCtx parser; struct ScriptObj *script; ParseTokenList tokenlist; - int line = 1; + Jim_Obj *fileNameObj; + int line; - if (objPtr->typePtr == &sourceObjType) { - line = objPtr->internalRep.sourceValue.lineNumber; - } + fileNameObj = Jim_GetSourceInfo(interp, objPtr, &line); ScriptTokenListInit(&tokenlist); @@ -9907,12 +10018,7 @@ static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) 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; - } + script->fileNameObj = fileNameObj; Jim_IncrRefCount(script->fileNameObj); script->missing = parser.missing.ch; script->linenr = parser.missing.line; @@ -11377,6 +11483,9 @@ void Jim_FreeInterp(Jim_Interp *i) JimFreeCallFrame(i, cf, JIM_FCF_FULL); } + + Jim_FreeHashTable(&i->commands); + Jim_DecrRefCount(i, i->emptyObj); Jim_DecrRefCount(i, i->trueObj); Jim_DecrRefCount(i, i->falseObj); @@ -11391,7 +11500,6 @@ void Jim_FreeInterp(Jim_Interp *i) Jim_InterpIncrProcEpoch(i); - Jim_FreeHashTable(&i->commands); #ifdef JIM_REFERENCES Jim_FreeHashTable(&i->references); #endif @@ -11590,16 +11698,24 @@ static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj) interp->errorFlag = 1; } -static void JimSetErrorStack(Jim_Interp *interp) +static void JimSetErrorStack(Jim_Interp *interp, ScriptObj *script) { if (!interp->errorFlag) { int i; Jim_Obj *stackTrace = Jim_NewListObj(interp, NULL, 0); - for (i = 0; i <= interp->procLevel; i++) { - Jim_EvalFrame *frame = JimGetEvalFrameByProcLevel(interp, -i); - if (frame) { - JimAddStackFrame(interp, frame, stackTrace); + if (interp->procLevel == 0 && script) { + Jim_ListAppendElement(interp, stackTrace, interp->emptyObj); + Jim_ListAppendElement(interp, stackTrace, script->fileNameObj); + Jim_ListAppendElement(interp, stackTrace, Jim_NewIntObj(interp, script->linenr)); + Jim_ListAppendElement(interp, stackTrace, interp->emptyObj); + } + else { + for (i = 0; i <= interp->procLevel; i++) { + Jim_EvalFrame *frame = JimGetEvalFrameByProcLevel(interp, -i); + if (frame) { + JimAddStackFrame(interp, frame, stackTrace); + } } } JimSetStackTrace(interp, stackTrace); @@ -12290,14 +12406,7 @@ static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) } - if (objPtr->typePtr == &sourceObjType) { - fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; - linenr = objPtr->internalRep.sourceValue.lineNumber; - } - else { - fileNameObj = interp->emptyObj; - linenr = 1; - } + fileNameObj = Jim_GetSourceInfo(interp, objPtr, &linenr); Jim_IncrRefCount(fileNameObj); @@ -12319,7 +12428,7 @@ static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC) continue; elementPtr = JimParserGetTokenObj(interp, &parser); - JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline); + Jim_SetSourceInfo(interp, elementPtr, fileNameObj, parser.tline); ListAppendElement(objPtr, elementPtr); } } @@ -12374,7 +12483,8 @@ struct lsort_info { JIM_LSORT_NOCASE, JIM_LSORT_INTEGER, JIM_LSORT_REAL, - JIM_LSORT_COMMAND + JIM_LSORT_COMMAND, + JIM_LSORT_DICT } type; int order; Jim_Obj **indexv; @@ -12407,6 +12517,43 @@ static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj) return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order; } +static int ListSortDict(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + + const char *left = Jim_String(*lhsObj); + const char *right = Jim_String(*rhsObj); + + while (1) { + if (isdigit(UCHAR(*left)) && isdigit(UCHAR(*right))) { + + jim_wide lint, rint; + char *lend, *rend; + lint = jim_strtoull(left, &lend); + rint = jim_strtoull(right, &rend); + if (lint != rint) { + return JimSign(lint - rint) * sort_info->order; + } + if (lend -left != rend - right) { + return JimSign((lend - left) - (rend - right)) * sort_info->order; + } + left = lend; + right = rend; + } + else { + int cl, cr; + left += utf8_tounicode_case(left, &cl, 1); + right += utf8_tounicode_case(right, &cr, 1); + if (cl != cr) { + return JimSign(cl - cr) * sort_info->order; + } + if (cl == 0) { + + return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order; + } + } + } +} + static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj) { jim_wide lhs = 0, rhs = 0; @@ -12521,6 +12668,9 @@ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsor case JIM_LSORT_COMMAND: fn = ListSortCommand; break; + case JIM_LSORT_DICT: + fn = ListSortDict; + break; default: fn = NULL; JimPanic((1, "ListSort called with invalid sort type")); @@ -12570,6 +12720,11 @@ static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *co int i; Jim_Obj **point; + if (elemc == 0) { + + return; + } + if (requiredLen > listPtr->internalRep.listValue.maxLen) { if (currentLen) { @@ -14334,6 +14489,8 @@ static const struct Jim_ExprOperator Jim_ExprOperators[] = { static int JimParseExpression(struct JimParserCtx *pc) { + pc->errmsg = NULL; + while (1) { while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) { @@ -14384,6 +14541,7 @@ singlechar: else { if (pc->tt == JIM_TT_EXPRSUGAR) { + pc->errmsg = "nesting expr in expr is not allowed"; return JIM_ERR; } return JIM_OK; @@ -14528,6 +14686,7 @@ static int JimParseExprOperator(struct JimParserCtx *pc) p++; } if (*p != '(') { + pc->errmsg = "function requires parentheses"; return JIM_ERR; } } @@ -14539,31 +14698,6 @@ static int JimParseExprOperator(struct JimParserCtx *pc) 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); @@ -14869,7 +15003,7 @@ missingoperand: objPtr = Jim_NewStringObj(interp, t->token, t->len); if (t->type == JIM_TT_CMD) { - JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line); + Jim_SetSourceInfo(interp, objPtr, builder->fileNameObj, t->line); } } @@ -14967,14 +15101,7 @@ static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) int rc = JIM_ERR; - if (objPtr->typePtr == &sourceObjType) { - fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; - line = objPtr->internalRep.sourceValue.lineNumber; - } - else { - fileNameObj = interp->emptyObj; - line = 1; - } + fileNameObj = Jim_GetSourceInfo(interp, objPtr, &line); Jim_IncrRefCount(fileNameObj); exprText = Jim_GetString(objPtr, &exprTextLen); @@ -14987,6 +15114,9 @@ static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) if (JimParseExpression(&parser) != JIM_OK) { ScriptTokenListFree(&tokenlist); Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr); + if (parser.errmsg) { + Jim_AppendStrings(interp, Jim_GetResult(interp), ": ", parser.errmsg, NULL); + } expr = NULL; goto err; } @@ -15006,10 +15136,17 @@ static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) } #endif - if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) { + if (tokenlist.count <= 1) { + Jim_SetResultString(interp, "empty expression", -1); + rc = JIM_ERR; + } + else { + rc = JimParseCheckMissing(interp, parser.missing.ch); + } + if (rc != JIM_OK) { ScriptTokenListFree(&tokenlist); Jim_DecrRefCount(interp, fileNameObj); - return JIM_ERR; + return rc; } @@ -15860,13 +15997,18 @@ static int JimTraceCallback(Jim_Interp *interp, const char *type, int argc, Jim_ Jim_Obj *nargv[7]; Jim_Obj *traceCmdObj = interp->traceCmdObj; Jim_Obj *resultObj = Jim_GetResult(interp); + ScriptObj *script = NULL; - ScriptObj *script = JimGetScript(interp, interp->evalFrame->scriptObj); + + + if (interp->evalFrame->scriptObj) { + script = JimGetScript(interp, interp->evalFrame->scriptObj); + } nargv[0] = traceCmdObj; nargv[1] = Jim_NewStringObj(interp, type, -1); - nargv[2] = script->fileNameObj; - nargv[3] = Jim_NewIntObj(interp, script->linenr); + nargv[2] = script ? script->fileNameObj : interp->emptyObj; + nargv[3] = Jim_NewIntObj(interp, script ? script->linenr : 1); nargv[4] = resultObj; nargv[5] = argv[0]; nargv[6] = Jim_NewListObj(interp, argv + 1, argc - 1); @@ -15988,7 +16130,7 @@ tailcall: retcode = cmdPtr->u.native.cmdProc(interp, objc, objv); } if (retcode == JIM_ERR) { - JimSetErrorStack(interp); + JimSetErrorStack(interp, NULL); } } @@ -16023,7 +16165,7 @@ out: JimDecrCmdRefCount(interp, cmdPtr); if (retcode == JIM_ERR) { - JimSetErrorStack(interp); + JimSetErrorStack(interp, NULL); } if (interp->framePtr->tailcallObj) { @@ -16045,6 +16187,7 @@ int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv) for (i = 0; i < objc; i++) Jim_IncrRefCount(objv[i]); + JimPushEvalFrame(interp, &frame, NULL); retcode = JimInvokeCommand(interp, objc, objv); @@ -16183,7 +16326,9 @@ static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * tok } else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) { - JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber); + int line; + Jim_Obj *fileNameObj = Jim_GetSourceInfo(interp, intv[0], &line); + Jim_SetSourceInfo(interp, objPtr, fileNameObj, line); } @@ -16250,7 +16395,7 @@ int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr) Jim_IncrRefCount(scriptObjPtr); script = JimGetScript(interp, scriptObjPtr); if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) { - JimSetErrorStack(interp); + JimSetErrorStack(interp, script); Jim_DecrRefCount(interp, scriptObjPtr); return JIM_ERR; } @@ -16422,7 +16567,7 @@ int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr) if (retcode == JIM_ERR) { - JimSetErrorStack(interp); + JimSetErrorStack(interp, NULL); } JimPopEvalFrame(interp); @@ -16650,7 +16795,7 @@ int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const c scriptObjPtr = Jim_NewStringObj(interp, script, -1); Jim_IncrRefCount(scriptObjPtr); if (filename) { - JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno); + Jim_SetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno); } retval = Jim_EvalObj(interp, scriptObjPtr); Jim_DecrRefCount(interp, scriptObjPtr); @@ -16732,7 +16877,7 @@ int Jim_EvalFile(Jim_Interp *interp, const char *filename) } filenameObj = Jim_NewStringObj(interp, filename, -1); - JimSetSourceInfo(interp, scriptObjPtr, filenameObj, 1); + Jim_SetSourceInfo(interp, scriptObjPtr, filenameObj, 1); oldFilenameObj = JimPushInterpObj(interp->currentFilenameObj, filenameObj); @@ -16773,7 +16918,9 @@ static void JimParseSubst(struct JimParserCtx *pc, int flags) } pc->tstart = pc->p; - flags |= JIM_SUBST_NOVAR; + + pc->p++; + pc->len--; } while (pc->len) { if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) { @@ -17276,7 +17423,7 @@ static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar static int JimCheckLoopRetcode(Jim_Interp *interp, int retval) { if (retval == JIM_BREAK || retval == JIM_CONTINUE) { - if (--interp->returnLevel > 0) { + if (--interp->break_level > 0) { return 1; } } @@ -17466,15 +17613,14 @@ static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) { retval = Jim_EvalObj(interp, argv[4]); - + if (JimCheckLoopRetcode(interp, retval)) { + immediate++; + break; + } if (retval == JIM_OK || retval == JIM_CONTINUE) { JIM_IF_OPTIM(evalnext:) retval = Jim_EvalObj(interp, argv[3]); - if (JimCheckLoopRetcode(interp, retval)) { - immediate++; - goto out; - } if (retval == JIM_OK || retval == JIM_CONTINUE) { JIM_IF_OPTIM(testcond:) @@ -17505,7 +17651,7 @@ static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg { int retval; jim_wide i; - jim_wide limit; + jim_wide limit = 0; jim_wide incr = 1; Jim_Obj *bodyObjPtr; @@ -18329,17 +18475,19 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg { static const char * const options[] = { "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", - "-stride", NULL + "-stride", "-dictionary", NULL }; enum { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE, - OPT_STRIDE + OPT_STRIDE, OPT_DICT }; Jim_Obj *resObj; int i; int retCode; int shared; long stride = 1; + Jim_Obj **elements; + int listlen; struct lsort_info info; @@ -18366,6 +18514,9 @@ wrongargs: case OPT_ASCII: info.type = JIM_LSORT_ASCII; break; + case OPT_DICT: + info.type = JIM_LSORT_DICT; + break; case OPT_NOCASE: info.type = JIM_LSORT_NOCASE; break; @@ -18420,13 +18571,17 @@ badindex: } } resObj = argv[argc - 1]; + JimListGetElements(interp, resObj, &listlen, &elements); + if (listlen <= 1) { + + Jim_SetResult(interp, resObj); + return JIM_OK; + } + 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; @@ -18614,7 +18769,7 @@ static int JimBreakContinueHelper(Jim_Interp *interp, int argc, Jim_Obj *const * if (ret != JIM_OK) { return ret; } - interp->returnLevel = level; + interp->break_level = level; } return retcode; } @@ -20332,7 +20487,6 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg return JIM_OK; case INFO_SOURCE:{ - jim_wide line; Jim_Obj *resObjPtr; Jim_Obj *fileNameObj; @@ -20341,26 +20495,16 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg return JIM_ERR; } if (argc == 5) { + jim_wide line; 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); + Jim_SetSourceInfo(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; - } + int line; + fileNameObj = Jim_GetSourceInfo(interp, argv[2], &line); resObjPtr = Jim_NewListObj(interp, NULL, 0); Jim_ListAppendElement(interp, resObjPtr, fileNameObj); Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line)); @@ -20819,11 +20963,12 @@ char **Jim_GetEnviron(void) { #if defined(HAVE__NSGETENVIRON) return *_NSGetEnviron(); +#elif defined(_environ) + return _environ; #else #if !defined(NO_ENVIRON_EXTERN) extern char **environ; #endif - return environ; #endif } @@ -20832,6 +20977,8 @@ void Jim_SetEnviron(char **env) { #if defined(HAVE__NSGETENVIRON) *_NSGetEnviron() = env; +#elif defined(_environ) + _environ = env; #else #if !defined(NO_ENVIRON_EXTERN) extern char **environ; @@ -23450,7 +23597,7 @@ void Jim_SetResultErrno(Jim_Interp *interp, const char *msg) Jim_SetResultFormatted(interp, "%s: %s", msg, strerror(Jim_Errno())); } -#if defined(__MINGW32__) +#if defined(_WIN32) || defined(WIN32) #include <sys/stat.h> int Jim_Errno(void) @@ -23646,7 +23793,9 @@ int Jim_MakeTempFile(Jim_Interp *interp, const char *filename_template, int unli } +#ifdef HAVE_UMASK mask = umask(S_IXUSR | S_IRWXG | S_IRWXO); +#endif #ifdef HAVE_MKSTEMP fd = mkstemp(filenameObj->bytes); #else @@ -23657,7 +23806,9 @@ int Jim_MakeTempFile(Jim_Interp *interp, const char *filename_template, int unli fd = open(filenameObj->bytes, O_RDWR | O_CREAT | O_TRUNC); } #endif +#ifdef HAVE_UMASK umask(mask); +#endif if (fd < 0) { Jim_SetResultErrno(interp, Jim_String(filenameObj)); Jim_FreeNewObj(interp, filenameObj); @@ -24260,6 +24411,11 @@ int main(int argc, char *const argv[]) Jim_SetVariableStrWithStr(interp, "jim::argv0", orig_argv0); Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, argc == 1 ? "1" : "0"); +#ifdef USE_LINENOISE + Jim_SetVariableStrWithStr(interp, "jim::lineedit", "1"); +#else + Jim_SetVariableStrWithStr(interp, "jim::lineedit", "0"); +#endif retcode = Jim_initjimshInit(interp); if (argc == 1) { diff --git a/autosetup/system.tcl b/autosetup/system.tcl index f23781b..05d378a 100644 --- a/autosetup/system.tcl +++ b/autosetup/system.tcl @@ -55,6 +55,8 @@ options { program-prefix: program-suffix: program-transform-name: + x-includes: + x-libraries: } # @check-feature name { script } @@ -318,95 +320,101 @@ proc make-template {template {out {}}} { } } -# build/host tuples and cross-compilation prefix -opt-str build build "" -define build_alias $build -if {$build eq ""} { - define build [config_guess] -} else { - define build [config_sub $build] -} +proc system-init {} { + global autosetup -opt-str host host "" -define host_alias $host -if {$host eq ""} { - define host [get-define build] - set cross "" -} else { - define host [config_sub $host] - set cross $host- -} -define cross [get-env CROSS $cross] + # build/host tuples and cross-compilation prefix + opt-str build build "" + define build_alias $build + if {$build eq ""} { + define build [config_guess] + } else { + define build [config_sub $build] + } -# build/host _cpu, _vendor and _os -foreach type {build host} { - set v [get-define $type] - if {![regexp {^([^-]+)-([^-]+)-(.*)$} $v -> cpu vendor os]} { - user-error "Invalid canonical $type: $v" + opt-str host host "" + define host_alias $host + if {$host eq ""} { + define host [get-define build] + set cross "" + } else { + define host [config_sub $host] + set cross $host- } - define ${type}_cpu $cpu - define ${type}_vendor $vendor - define ${type}_os $os -} + define cross [get-env CROSS $cross] -opt-str prefix prefix /usr/local - -# These are for compatibility with autoconf -define target [get-define host] -define prefix $prefix -define builddir $autosetup(builddir) -define srcdir $autosetup(srcdir) -define top_srcdir $autosetup(srcdir) -define abs_top_srcdir [file-normalize $autosetup(srcdir)] -define abs_top_builddir [file-normalize $autosetup(builddir)] - -# autoconf supports all of these -define exec_prefix [opt-str exec-prefix exec_prefix $prefix] -foreach {name defpath} { - bindir /bin - sbindir /sbin - libexecdir /libexec - libdir /lib -} { - define $name [opt-str $name o $exec_prefix$defpath] -} -foreach {name defpath} { - datadir /share - sharedstatedir /com - infodir /share/info - mandir /share/man - includedir /include -} { - define $name [opt-str $name o $prefix$defpath] -} -if {$prefix ne {/usr}} { - opt-str sysconfdir sysconfdir $prefix/etc -} else { - opt-str sysconfdir sysconfdir /etc -} -define sysconfdir $sysconfdir + # build/host _cpu, _vendor and _os + foreach type {build host} { + set v [get-define $type] + if {![regexp {^([^-]+)-([^-]+)-(.*)$} $v -> cpu vendor os]} { + user-error "Invalid canonical $type: $v" + } + define ${type}_cpu $cpu + define ${type}_vendor $vendor + define ${type}_os $os + } + + opt-str prefix prefix /usr/local + + # These are for compatibility with autoconf + define target [get-define host] + define prefix $prefix + define builddir $autosetup(builddir) + define srcdir $autosetup(srcdir) + define top_srcdir $autosetup(srcdir) + define abs_top_srcdir [file-normalize $autosetup(srcdir)] + define abs_top_builddir [file-normalize $autosetup(builddir)] + + # autoconf supports all of these + define exec_prefix [opt-str exec-prefix exec_prefix $prefix] + foreach {name defpath} { + bindir /bin + sbindir /sbin + libexecdir /libexec + libdir /lib + } { + define $name [opt-str $name o $exec_prefix$defpath] + } + foreach {name defpath} { + datadir /share + sharedstatedir /com + infodir /share/info + mandir /share/man + includedir /include + } { + define $name [opt-str $name o $prefix$defpath] + } + if {$prefix ne {/usr}} { + opt-str sysconfdir sysconfdir $prefix/etc + } else { + opt-str sysconfdir sysconfdir /etc + } + define sysconfdir $sysconfdir -define localstatedir [opt-str localstatedir o /var] -define runstatedir [opt-str runstatedir o /run] + define localstatedir [opt-str localstatedir o /var] + define runstatedir [opt-str runstatedir o /run] -define SHELL [get-env SHELL [find-an-executable sh bash ksh]] + define SHELL [get-env SHELL [find-an-executable sh bash ksh]] -# These could be used to generate Makefiles following some automake conventions -define AM_SILENT_RULES [opt-bool silent-rules] -define AM_MAINTAINER_MODE [opt-bool maintainer-mode] -define AM_DEPENDENCY_TRACKING [opt-bool dependency-tracking] + # These could be used to generate Makefiles following some automake conventions + define AM_SILENT_RULES [opt-bool silent-rules] + define AM_MAINTAINER_MODE [opt-bool maintainer-mode] + define AM_DEPENDENCY_TRACKING [opt-bool dependency-tracking] -# Windows vs. non-Windows -switch -glob -- [get-define host] { - *-*-ming* - *-*-cygwin - *-*-msys { - define-feature windows - define EXEEXT .exe - } - default { - define EXEEXT "" + # Windows vs. non-Windows + switch -glob -- [get-define host] { + *-*-ming* - *-*-cygwin - *-*-msys { + define-feature windows + define EXEEXT .exe + } + default { + define EXEEXT "" + } } + + # Display + msg-result "Host System...[get-define host]" + msg-result "Build System...[get-define build]" } -# Display -msg-result "Host System...[get-define host]" -msg-result "Build System...[get-define build]" +system-init diff --git a/ensemble.tcl b/ensemble.tcl index 9e87809..5c49808 100644 --- a/ensemble.tcl +++ b/ensemble.tcl @@ -18,7 +18,7 @@ proc ensemble {command args} { if {$subcmd in {-commands -help}} { # Need to remove $autoprefix from the front of these set prefixlen [string length $autoprefix] - set subcmds [lmap p [lsort [info commands $autoprefix*]] { + set subcmds [lmap p [lsort [info commands -all $autoprefix*]] { string range $p $prefixlen end }] if {$subcmd eq "-commands"} { diff --git a/examples.api/jim_command.c b/examples.api/jim_command.c index ce9a8ac..431b262 100644 --- a/examples.api/jim_command.c +++ b/examples.api/jim_command.c @@ -44,16 +44,11 @@ MySampleCommandFunc(Jim_Interp *interp, int argc, Jim_Obj *const *argv) const char *str; int len; - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "string"); - return (JIM_ERR); - } - + /* No need to check arg count here as this is checked by Jim_RegisterCmd() */ str = Jim_GetString(argv[1], &len); - assert(str != NULL); printf("%s\n", str); - return (JIM_OK); + return JIM_OK; } /* @@ -77,9 +72,8 @@ main(int argc, char **argv) /* And initialise any static extensions */ Jim_InitStaticExtensions(interp); - /* Register our Jim commands. */ - Jim_CreateCommand(interp, "MySampleCommand", MySampleCommandFunc, - NULL, NULL); + /* Register our Jim commands. This includes usage and min/max arg count */ + Jim_RegisterSimpleCmd(interp, "MySampleCommand", "string", 1, 1, MySampleCommandFunc); /* Run a script. */ error = Jim_Eval(interp, JIM_PROGRAM); diff --git a/examples.api/jim_return.c b/examples.api/jim_return.c index 4f5a272..383b428 100644 --- a/examples.api/jim_return.c +++ b/examples.api/jim_return.c @@ -44,10 +44,6 @@ static int CountCharsFunc(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "string"); - return (JIM_ERR); - } Jim_SetResult(interp, Jim_NewIntObj(interp, Jim_Length(argv[1]))); return (JIM_OK); } @@ -73,10 +69,8 @@ main(int argc, char **argv) /* And initialise any static extensions */ Jim_InitStaticExtensions(interp); - /* Register our Jim command. */ - Jim_CreateCommand(interp, "CountChars", CountCharsFunc, - NULL, NULL); + Jim_RegisterSimpleCmd(interp, "CountChars", "string", 1, 1, CountCharsFunc); /* Run a script. */ error = Jim_Eval(interp, JIM_PROGRAM); diff --git a/examples.ext/helloworld.c b/examples.ext/helloworld.c index 371a23d..db0fc44 100644 --- a/examples.ext/helloworld.c +++ b/examples.ext/helloworld.c @@ -19,6 +19,8 @@ Hello_Cmd(Jim_Interp *interp, int objc, Jim_Obj *const objv[]) int Jim_helloworldInit(Jim_Interp *interp) { - Jim_CreateCommand(interp, "hello", Hello_Cmd, NULL, NULL); + /* Register the package with Jim and check that the ABI matches the interpreter */ + Jim_PackageProvideCheck(interp, "helloworld"); + Jim_RegisterSimpleCmd(interp, "hello", "", 0, 0, Hello_Cmd); return JIM_OK; } diff --git a/examples/udp.client b/examples/udp.client index 9e9ac14..312bb46 100644 --- a/examples/udp.client +++ b/examples/udp.client @@ -26,3 +26,8 @@ foreach i [range 5 10] { # Receive the response - max length of 100 puts [$s recvfrom 100] } + +# If taint is supported, this is an unsafe command +# and the server will refuse to do it +$s puts -nonewline {[exec echo hello]} +puts [$s recvfrom 100] diff --git a/examples/udp.server b/examples/udp.server index 03f41cd..cc026f0 100644 --- a/examples/udp.server +++ b/examples/udp.server @@ -3,6 +3,12 @@ # Listen on port 20000. No host specified means 0.0.0.0 set s [socket dgram.server 20000] +# We won't run unsafe commands, but +# we don't mind sending anything back +catch { + $s taint sink 0 +} + # For each request... $s readable { # Get the request (max 80 chars) - need the source address diff --git a/initjimsh.tcl b/initjimsh.tcl index 6fa54c6..2a37ec0 100644 --- a/initjimsh.tcl +++ b/initjimsh.tcl @@ -10,8 +10,14 @@ proc _jimsh_init {} { if {[string match "*/*" $jim::argv0]} { set jim::exe [file join [pwd] $jim::argv0] } else { - foreach path [split [env PATH ""] $tcl_platform(pathSeparator)] { - set exec [file join [pwd] [string map {\\ /} $path] $jim::argv0] + set jim::argv0 [file tail $jim::argv0] + set path [split [env PATH ""] $tcl_platform(pathSeparator)] + if {$tcl_platform(platform) eq "windows"} { + # Windows searches the current directory first, and convert backslashes to slashes + set path [lmap p [list "" {*}$path] { string map {\\ /} $p }] + } + foreach p $path { + set exec [file join [pwd] $p $jim::argv0] if {[file executable $exec]} { set jim::exe $exec break @@ -106,8 +112,8 @@ set tcl::stdhint_col $tcl::stdhint_cols(lcyan) # The default hint implementation proc tcl::stdhint {string} { set result "" + lassign $string cmd arg if {[llength $string] >= 2} { - lassign $string cmd arg if {$cmd in $::tcl::stdhint_commands || [info channel $cmd] ne ""} { catch { set help [$cmd -help $arg] @@ -129,6 +135,23 @@ proc tcl::stdhint {string} { } } } + } else { + catch { + if {[exists -alias $cmd] && [llength [info alias $cmd]] == 1} { + # Look through a simple alias. Doesn't really work for anything more complex. + # consider 'alias p stderr puts' where we can't really provide the usage + # of 'stderr puts' + set help [info usage [info alias $cmd]] + } else { + set help [info usage $cmd] + } + set hint [join [lrange $help 1 end]] + set prefix " " + if {[string match "* " $string]} { + set prefix "" + } + set result [list $prefix$hint {*}$::tcl::stdhint_col] + } } return $result } @@ -85,14 +85,17 @@ #include "jimiocompat.h" #define AIO_CMD_LEN 32 /* e.g. aio.handleXXXXXX */ -#define AIO_BUF_LEN 256 /* read size for gets, read */ -#define AIO_WBUF_FULL_SIZE (64 * 1024) /* This could be configurable */ +#define AIO_DEFAULT_RBUF_LEN 256 /* read size for gets, read */ +#define AIO_DEFAULT_WBUF_LIMIT (64 * 1024) /* max size of writebuf before flushing */ #define AIO_KEEPOPEN 1 /* don't set O_CLOEXEC, don't close on command delete */ #define AIO_NODELETE 2 /* don't delete AF_UNIX path on close */ #define AIO_EOF 4 /* EOF was reached */ #define AIO_WBUF_NONE 8 /* default to buffering=none */ #define AIO_NONBLOCK 16 /* socket is non-blocking */ +#define AIO_NOTAINT 32 /* Don't set taint on the channel */ + +#define AIO_ONEREAD 32 /* passed to aio_read_len() to return after a single read */ enum wbuftype { WBUF_OPT_NONE, /* write immediately */ @@ -114,10 +117,6 @@ enum wbuftype { #define UNIX_SOCKETS 0 #endif -#ifndef MAXPATHLEN -#define MAXPATHLEN JIM_PATH_LEN -#endif - #if defined(HAVE_SOCKETS) && !defined(JIM_BOOTSTRAP) /* Avoid type punned pointers */ union sockaddr_any { @@ -187,16 +186,29 @@ typedef struct AioFile int flags; /* AIO_KEEPOPEN | AIO_NODELETE | AIO_EOF */ long timeout; /* timeout (in ms) for read operations if blocking */ int fd; + unsigned taintsource; /* Data read from the file are tainted with this value */ + unsigned taintsink; /* Data with any of these taint types can't be written to this file */ int addr_family; void *ssl; const JimAioFopsType *fops; Jim_Obj *readbuf; /* Contains any buffered read data. NULL if empty. refcount=0 */ Jim_Obj *writebuf; /* Contains any buffered write data. refcount=1 */ + char *rbuf; /* Temporary read buffer (NULL if not yet allocated) */ + size_t rbuf_len; /* Length of rbuf */ + size_t wbuf_limit; /* Max size of writebuf before flushing */ } AioFile; +static void aio_consume(Jim_Obj *objPtr, int n); + static int stdio_writer(struct AioFile *af, const char *buf, int len) { - return write(af->fd, buf, len); + int ret = write(af->fd, buf, len); + if (ret < 0 && errno == EPIPE) { + /* Also discard the write buffer since otherwise when + * we try to flush on shutdown we may get SIGPIPE */ + aio_consume(af->writebuf, Jim_Length(af->writebuf)); + } + return ret; } static int stdio_reader(struct AioFile *af, char *buf, int len, int nb) @@ -371,6 +383,7 @@ static int aio_start_nonblocking(AioFile *af) } static int JimAioSubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv); +static void JimAioSetTaint(AioFile *af, int taintsource, int taintsink); static AioFile *JimMakeChannel(Jim_Interp *interp, int fd, Jim_Obj *filename, const char *hdlfmt, int family, int flags); @@ -624,9 +637,7 @@ static int JimSetVariableSocketAddress(Jim_Interp *interp, Jim_Obj *varObjPtr, c { int ret; Jim_Obj *objPtr = JimFormatSocketAddress(interp, sa, salen); - Jim_IncrRefCount(objPtr); ret = Jim_SetVariable(interp, varObjPtr, objPtr); - Jim_DecrRefCount(interp, objPtr); return ret; } @@ -710,7 +721,26 @@ static void aio_consume(Jim_Obj *objPtr, int n) } /* forward declaration */ -static int aio_autoflush(Jim_Interp *interp, void *clientData, int mask); +static int aio_flush(Jim_Interp *interp, AioFile *af); + +#ifdef jim_ext_eventloop +/** + * Called when the channel is writable. + * Write what we can and return -1 when the write buffer is empty to remove the handler. + */ +static int aio_autoflush(Jim_Interp *interp, void *clientData, int mask) +{ + AioFile *af = clientData; + + aio_flush(interp, af); + if (Jim_Length(af->writebuf) == 0) { + /* Done, so remove the handler */ + return -1; + } + return 0; +} +#endif + /** * Flushes af->writebuf to the channel and removes that data @@ -759,30 +789,18 @@ static int aio_flush(Jim_Interp *interp, AioFile *af) } /** - * Called when the channel is writable. - * Write what we can and return -1 when the write buffer is empty to remove the handler. - */ -static int aio_autoflush(Jim_Interp *interp, void *clientData, int mask) -{ - AioFile *af = clientData; - - aio_flush(interp, af); - if (Jim_Length(af->writebuf) == 0) { - /* Done, so remove the handler */ - return -1; - } - return 0; -} - -/** * Read until 'len' bytes are available in readbuf. * + * If flags contains AIO_NONBLOCK, indicates a nonblocking read. + * If flags contains AIO_ONEREAD, return after a single read. + * (In this case JIM_ERR is also returned on timeout) + * * If nonblocking or timeout, may return early. * 'len' may be -1 to read until eof (or until no more data if nonblocking) * * Returns JIM_OK if data was read or JIM_ERR on error. */ -static int aio_read_len(Jim_Interp *interp, AioFile *af, int nb, char *buf, size_t buflen, int neededLen) +static int aio_read_len(Jim_Interp *interp, AioFile *af, unsigned flags, int neededLen) { if (!af->readbuf) { af->readbuf = Jim_NewStringObj(interp, NULL, 0); @@ -800,20 +818,29 @@ static int aio_read_len(Jim_Interp *interp, AioFile *af, int nb, char *buf, size int readlen; if (neededLen == -1) { - readlen = AIO_BUF_LEN; + readlen = af->rbuf_len; } else { - readlen = (neededLen > AIO_BUF_LEN ? AIO_BUF_LEN : neededLen); + readlen = (neededLen > af->rbuf_len ? af->rbuf_len : neededLen); } - retval = af->fops->reader(af, buf, readlen, nb); + /* Allocate buffer if not already allocated */ + if (!af->rbuf) { + af->rbuf = Jim_Alloc(af->rbuf_len); + } + retval = af->fops->reader(af, af->rbuf, readlen, flags & AIO_NONBLOCK); if (retval > 0) { - Jim_AppendString(interp, af->readbuf, buf, retval); + if (retval) { + Jim_AppendString(interp, af->readbuf, af->rbuf, retval); + } if (neededLen != -1) { neededLen -= retval; } + if (flags & AIO_ONEREAD) { + return JIM_OK; + } continue; } - if (JimCheckStreamError(interp, af)) { + if ((flags & AIO_ONEREAD) || JimCheckStreamError(interp, af)) { return JIM_ERR; } break; @@ -892,6 +919,7 @@ static void JimAioDelProc(Jim_Interp *interp, void *privData) Jim_FreeNewObj(interp, af->readbuf); } + Jim_Free(af->rbuf); Jim_Free(af); } @@ -905,7 +933,6 @@ static int aio_cmd_read(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int option; int nb; Jim_Obj *objPtr; - char buf[AIO_BUF_LEN]; if (argc) { if (*Jim_String(argv[0]) == '-') { @@ -933,17 +960,18 @@ static int aio_cmd_read(Jim_Interp *interp, int argc, Jim_Obj *const *argv) argv++; } if (argc) { - return -1; + return JIM_USAGE; } /* reads are nonblocking if a timeout is given */ nb = aio_start_nonblocking(af); - if (aio_read_len(interp, af, nb, buf, sizeof(buf), neededLen) != JIM_OK) { + if (aio_read_len(interp, af, nb ? AIO_NONBLOCK : 0, neededLen) != JIM_OK) { aio_set_nonblocking(af, nb); return JIM_ERR; } objPtr = aio_read_consume(interp, af, neededLen); + Jim_TaintObj(objPtr, af->taintsource); aio_set_nonblocking(af, nb); @@ -973,7 +1001,7 @@ int Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *command) Jim_Cmd *cmdPtr = Jim_GetCommand(interp, command, JIM_ERRMSG); /* XXX: There ought to be a supported API for this */ - if (cmdPtr && !cmdPtr->isproc && cmdPtr->u.native.cmdProc == JimAioSubCmdProc) { + if (cmdPtr && !(cmdPtr->flags & JIM_CMD_ISPROC) && cmdPtr->u.native.cmdProc == JimAioSubCmdProc) { return ((AioFile *) cmdPtr->u.native.privData)->fd; } Jim_SetResultFormatted(interp, "Not a filehandle: \"%#s\"", command); @@ -992,18 +1020,38 @@ static int aio_cmd_getfd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_OK; } +static int aio_cmd_gettaint(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + static const char * const options[] = { "-source", "-sink", NULL }; + enum { OPT_SOURCE, OPT_SINK }; + int option; + + if (Jim_GetEnum(interp, argv[0], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_SOURCE: + Jim_SetResultInt(interp, af->taintsource); + break; + + case OPT_SINK: + Jim_SetResultInt(interp, af->taintsink); + break; + } + + 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; - /* Small, static buffer for small files */ - char buf[AIO_BUF_LEN]; - /* Will be allocated if the file is large */ - char *bufp = buf; - int buflen = sizeof(buf); int ok = 1; Jim_Obj *objv[4]; + long taintsink; if (argc == 2) { if (Jim_GetWide(interp, argv[1], &maxlen) != JIM_OK) { @@ -1011,6 +1059,19 @@ static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) } } + objv[0] = argv[0]; + objv[1] = Jim_NewStringObj(interp, "gettaint", -1); + objv[2] = Jim_NewStringObj(interp, "-sink", -1); + if (Jim_EvalObjVector(interp, 3, objv) != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &taintsink) != JIM_OK) { + Jim_SetResultFormatted(interp, "Not a filehandle: \"%#s\"", argv[0]); + return JIM_ERR; + } + + if (af->taintsource & taintsink) { + Jim_SetResultString(interp, "copying tainted source", -1); + return JIM_ERR; + } + /* Need to flush any write data first. This could fail because of send buf full, * but more likely because the target isn't a filehandle. * Should use use getfd to test for that case instead? @@ -1031,10 +1092,10 @@ static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) while (count < maxlen) { jim_wide len = maxlen - count; - if (len > buflen) { - len = buflen; + if (len > af->rbuf_len) { + len = af->rbuf_len; } - if (aio_read_len(interp, af, 0, bufp, buflen, len) != JIM_OK) { + if (aio_read_len(interp, af, 0, len) != JIM_OK) { ok = 0; break; } @@ -1047,17 +1108,13 @@ static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) if (aio_eof(af)) { break; } - if (count >= 16384 && bufp == buf) { + if (count >= 16384 && af->rbuf_len < 65536) { /* Heuristic check - for large copy speed-up */ - buflen = 65536; - bufp = Jim_Alloc(buflen); + af->rbuf_len = 65536; + af->rbuf = Jim_Realloc(af->rbuf, af->rbuf_len); } } - if (bufp != buf) { - Jim_Free(bufp); - } - Jim_DecrRefCount(interp, objv[1]); Jim_DecrRefCount(interp, objv[2]); @@ -1073,10 +1130,10 @@ static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) 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 = NULL; int len; int nb; + unsigned flags = AIO_ONEREAD; char *nl = NULL; int offset = 0; @@ -1084,33 +1141,33 @@ static int aio_cmd_gets(Jim_Interp *interp, int argc, Jim_Obj *const *argv) /* reads are non-blocking if a timeout has been given */ nb = aio_start_nonblocking(af); - - if (!af->readbuf) { - af->readbuf = Jim_NewStringObj(interp, NULL, 0); + if (nb) { + flags |= AIO_NONBLOCK; } while (!aio_eof(af)) { - const char *pt = Jim_GetString(af->readbuf, &len); - nl = memchr(pt + offset, '\n', len - offset); - if (nl) { - /* got a line */ - objPtr = Jim_NewStringObj(interp, pt, nl - pt); - /* And consume it plus the newline */ - aio_consume(af->readbuf, nl - pt + 1); - break; + if (af->readbuf) { + const char *pt = Jim_GetString(af->readbuf, &len); + nl = memchr(pt + offset, '\n', len - offset); + if (nl) { + /* got a line */ + objPtr = Jim_NewStringObj(interp, pt, nl - pt); + /* And consume it plus the newline */ + aio_consume(af->readbuf, nl - pt + 1); + break; + } + offset = len; } - offset = len; - len = af->fops->reader(af, buf, AIO_BUF_LEN, nb); - if (len <= 0) { + /* Not got a line yet, so read more */ + if (aio_read_len(interp, af, flags, -1) != JIM_OK) { break; } - Jim_AppendString(interp, af->readbuf, buf, len); } aio_set_nonblocking(af, nb); - if (!nl && aio_eof(af)) { + if (!nl && aio_eof(af) && af->readbuf) { /* Just take what we have as the line */ objPtr = af->readbuf; af->readbuf = NULL; @@ -1118,10 +1175,10 @@ static int aio_cmd_gets(Jim_Interp *interp, int argc, Jim_Obj *const *argv) else if (!objPtr) { objPtr = Jim_NewStringObj(interp, NULL, 0); } + Jim_TaintObj(objPtr, af->taintsource); if (argc) { if (Jim_SetVariable(interp, argv[0], objPtr) != JIM_OK) { - Jim_FreeNewObj(interp, objPtr); return JIM_ERR; } @@ -1148,9 +1205,14 @@ static int aio_cmd_puts(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int wnow = 0; int nl = 1; + if (Jim_CheckTaint(interp, af->taintsink)) { + Jim_SetResultString(interp, "puts: tainted data", -1); + return JIM_ERR; + } + if (argc == 2) { if (!Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) { - return -1; + return JIM_USAGE; } strObj = argv[1]; nl = 0; @@ -1162,6 +1224,15 @@ static int aio_cmd_puts(Jim_Interp *interp, int argc, Jim_Obj *const *argv) /* Keep it simple and always go via the writebuf instead of trying to optimise * the case that we can write immediately */ +#ifdef JIM_MAINTAINER + if (Jim_IsShared(af->writebuf)) { + /* This should generally never happen since this object isn't accessible, + * but it is possible with 'debug objects' */ + Jim_DecrRefCount(interp, af->writebuf); + af->writebuf = Jim_DuplicateObj(interp, af->writebuf); + Jim_IncrRefCount(af->writebuf); + } +#endif Jim_AppendObj(interp, af->writebuf, strObj); if (nl) { Jim_AppendString(interp, af->writebuf, "\n", 1); @@ -1183,7 +1254,7 @@ static int aio_cmd_puts(Jim_Interp *interp, int argc, Jim_Obj *const *argv) break; case WBUF_OPT_FULL: - if (wlen >= AIO_WBUF_FULL_SIZE) { + if (wlen >= af->wbuf_limit) { wnow = 1; } break; @@ -1211,6 +1282,7 @@ static int aio_cmd_isatty(Jim_Interp *interp, int argc, Jim_Obj *const *argv) static int aio_cmd_recvfrom(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { AioFile *af = Jim_CmdPrivData(interp); + Jim_Obj *objPtr; char *buf; union sockaddr_any sa; long len; @@ -1230,7 +1302,10 @@ static int aio_cmd_recvfrom(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_ERR; } buf[rlen] = 0; - Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, rlen)); + + objPtr = Jim_NewStringObjNoAlloc(interp, buf, rlen); + Jim_TaintObj(objPtr, af->taintsource); + Jim_SetResult(interp, objPtr); if (argc > 1) { return JimSetVariableSocketAddress(interp, argv[1], &sa, salen); @@ -1250,6 +1325,10 @@ static int aio_cmd_sendto(Jim_Interp *interp, int argc, Jim_Obj *const *argv) const char *addr = Jim_String(argv[1]); socklen_t salen; + if (Jim_CheckTaint(interp, af->taintsink)) { + Jim_SetResultString(interp, "sendto: tainted data", -1); + return JIM_ERR; + } if (JimParseSocketAddress(interp, af->addr_family, SOCK_DGRAM, addr, &sa, &salen) != JIM_OK) { return JIM_ERR; } @@ -1272,7 +1351,8 @@ static int aio_cmd_sendto(Jim_Interp *interp, int argc, Jim_Obj *const *argv) static int aio_cmd_accept(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - AioFile *af = Jim_CmdPrivData(interp); + AioFile *serv_af = Jim_CmdPrivData(interp); + AioFile *af; int sock; union sockaddr_any sa; socklen_t salen = sizeof(sa); @@ -1280,7 +1360,7 @@ static int aio_cmd_accept(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int n = 0; int flags = AIO_NODELETE; - sock = accept(af->fd, &sa.sa, &salen); + sock = accept(serv_af->fd, &sa.sa, &salen); if (sock < 0) { JimAioSetError(interp, NULL); return JIM_ERR; @@ -1305,8 +1385,13 @@ static int aio_cmd_accept(Jim_Interp *interp, int argc, Jim_Obj *const *argv) } /* Create the file command */ - return JimMakeChannel(interp, sock, filenameObj, - "aio.sockstream%ld", af->addr_family, flags) ? JIM_OK : JIM_ERR; + af = JimMakeChannel(interp, sock, filenameObj, + "aio.sockstream%ld", serv_af->addr_family, flags); + if (af) { + JimAioSetTaint(af, serv_af->taintsource, serv_af->taintsink); + return JIM_OK; + } + return JIM_ERR; } static int aio_cmd_sockname(Jim_Interp *interp, int argc, Jim_Obj *const *argv) @@ -1424,7 +1509,7 @@ static int aio_cmd_seek(Jim_Interp *interp, int argc, Jim_Obj *const *argv) else if (Jim_CompareStringImmediate(interp, argv[1], "end")) orig = SEEK_END; else { - return -1; + return JIM_USAGE; } } if (Jim_GetWide(interp, argv[0], &offset) != JIM_OK) { @@ -1462,6 +1547,45 @@ static int aio_cmd_filename(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_OK; } +#ifdef JIM_TAINT +static int aio_cmd_taint(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + static const char * const types[] = { + "sink", + "source", + NULL + }; + enum + { + TAINT_TYPE_SINK, + TAINT_TYPE_SOURCE, + }; + int type; + long taint; + + if (Jim_GetEnum(interp, argv[0], types, &type, NULL, JIM_ERRMSG) != JIM_OK) + return JIM_ERR; + + if (argc == 1) { + Jim_SetResultInt(interp, type == TAINT_TYPE_SINK ? af->taintsink : af->taintsource); + return JIM_OK; + } + else if (Jim_GetLong(interp, argv[1], &taint) == JIM_OK) { + if (type == TAINT_TYPE_SINK) { + af->taintsink = taint; + } + else { + af->taintsource = taint; + } + return JIM_OK; + } + else { + return JIM_ERR; + } +} +#endif + #ifdef O_NDELAY static int aio_cmd_ndelay(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { @@ -1549,7 +1673,7 @@ static int aio_cmd_sockopt(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_OK; } if (argc == 1) { - return -1; + return JIM_USAGE; } /* Set an option */ @@ -1597,6 +1721,7 @@ static int aio_cmd_sync(Jim_Interp *interp, int argc, Jim_Obj *const *argv) static int aio_cmd_buffering(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { AioFile *af = Jim_CmdPrivData(interp); + Jim_Obj *resultObj; static const char * const options[] = { "none", @@ -1605,17 +1730,79 @@ static int aio_cmd_buffering(Jim_Interp *interp, int argc, Jim_Obj *const *argv) NULL }; - if (Jim_GetEnum(interp, argv[0], options, &af->wbuft, NULL, JIM_ERRMSG) != JIM_OK) { - return JIM_ERR; + if (argc) { + if (Jim_GetEnum(interp, argv[0], options, &af->wbuft, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + + if (af->wbuft == WBUF_OPT_FULL && argc == 2) { + long l; + if (Jim_GetLong(interp, argv[1], &l) != JIM_OK || l <= 0) { + return JIM_ERR; + } + af->wbuf_limit = l; + } + + if (af->wbuft == WBUF_OPT_NONE) { + if (aio_flush(interp, af) != JIM_OK) { + return JIM_ERR; + } + } + /* don't bother flushing when switching from full to line */ } - if (af->wbuft == WBUF_OPT_NONE) { - return aio_flush(interp, af); + resultObj = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, resultObj, Jim_NewStringObj(interp, options[af->wbuft], -1)); + if (af->wbuft == WBUF_OPT_FULL) { + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, af->wbuf_limit)); + } + Jim_SetResult(interp, resultObj); + + return JIM_OK; +} + +static int aio_cmd_translation(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + enum {OPT_BINARY, OPT_TEXT}; + static const char * const options[] = { + "binary", + "text", + NULL + }; + int opt; + + if (Jim_GetEnum(interp, argv[0], options, &opt, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } +#if defined(Jim_SetMode) + else { + AioFile *af = Jim_CmdPrivData(interp); + Jim_SetMode(af->fd, opt == OPT_BINARY ? O_BINARY : O_TEXT); + } +#endif + return JIM_OK; +} + +static int aio_cmd_readsize(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + if (argc) { + long l; + if (Jim_GetLong(interp, argv[0], &l) != JIM_OK || l <= 0) { + return JIM_ERR; + } + af->rbuf_len = l; + if (af->rbuf) { + af->rbuf = Jim_Realloc(af->rbuf, af->rbuf_len); + } } - /* don't bother flushing when switching from full to line */ + Jim_SetResultInt(interp, af->rbuf_len); + return JIM_OK; } +#ifdef jim_ext_eventloop static int aio_cmd_timeout(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { #ifdef HAVE_SELECT @@ -1633,7 +1820,6 @@ static int aio_cmd_timeout(Jim_Interp *interp, int argc, Jim_Obj *const *argv) #endif } -#ifdef jim_ext_eventloop static int aio_eventinfo(Jim_Interp *interp, AioFile * af, unsigned mask, int argc, Jim_Obj * const *argv) { @@ -1816,7 +2002,7 @@ static int aio_cmd_lock(Jim_Interp *interp, int argc, Jim_Obj *const *argv) if (argc == 1) { if (!Jim_CompareStringImmediate(interp, argv[0], "-wait")) { - return -1; + return JIM_USAGE; } lockmode = F_SETLKW; } @@ -1894,7 +2080,7 @@ static int aio_cmd_tty(Jim_Interp *interp, int argc, Jim_Obj *const *argv) if (Jim_ListLength(interp, dictObjPtr) % 2) { /* Must be a valid dictionary */ Jim_DecrRefCount(interp, dictObjPtr); - return -1; + return JIM_USAGE; } ret = Jim_SetTtySettings(interp, af->fd, dictObjPtr); @@ -1971,8 +2157,17 @@ static const jim_subcmd_type aio_command_table[] = { aio_cmd_getfd, 0, 0, + JIM_MODFLAG_HIDDEN, /* Description: Internal command to return the underlying file descriptor. */ }, + { "gettaint", + "?-source|-sink?", + aio_cmd_gettaint, + 1, + 1, + JIM_MODFLAG_HIDDEN, + /* Description: Internal command to return the taint of the channel. */ + }, { "gets", "?var?", aio_cmd_gets, @@ -2088,6 +2283,15 @@ static const jim_subcmd_type aio_command_table[] = { 0, /* Description: Returns the original filename */ }, +#ifdef JIM_TAINT + { "taint", + "source|sink ?0|n?", + aio_cmd_taint, + 1, + 2, + /* Description: Set or return the taint setting */ + }, +#endif #ifdef O_NDELAY { "ndelay", "?0|1?", @@ -2107,11 +2311,25 @@ static const jim_subcmd_type aio_command_table[] = { }, #endif { "buffering", - "none|line|full", + "?none|line|full? ?size?", aio_cmd_buffering, + 0, + 2, + /* Description: Sets or returns write buffering */ + }, + { "translation", + "binary|text", + aio_cmd_translation, + 1, 1, + /* Description: Sets output translation mode */ + }, + { "readsize", + "?size?", + aio_cmd_readsize, + 0, 1, - /* Description: Sets buffering */ + /* Description: Sets or returns read size */ }, #if defined(jim_ext_file) && defined(Jim_FileStat) { "stat", @@ -2312,19 +2530,25 @@ static int JimAioOpenCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { int openflags; + AioFile *af; const char *filename; int fd = -1; int n = 0; - int flags = 0; + /* filehandles created by open are not tainted by default */ + int flags = AIO_NOTAINT; if (argc > 2 && Jim_CompareStringImmediate(interp, argv[2], "-noclose")) { flags = AIO_KEEPOPEN; n++; } - if (argc < 2 || argc > 3 + n) { - Jim_WrongNumArgs(interp, 1, argv, "filename ?-noclose? ?mode?"); + + if (Jim_CheckTaint(interp, JIM_TAINT_ANY)) { + Jim_SetTaintError(interp, 1, argv); return JIM_ERR; } + if (argc > 3 + n) { + return JIM_USAGE; + } filename = Jim_String(argv[1]); @@ -2355,13 +2579,20 @@ static int JimAioOpenCommand(Jim_Interp *interp, int argc, else { openflags = O_RDONLY; } + fd = open(filename, openflags, 0666); if (fd < 0) { JimAioSetError(interp, argv[1]); return JIM_ERR; } - return JimMakeChannel(interp, fd, argv[1], "aio.handle%ld", 0, flags) ? JIM_OK : JIM_ERR; + af = JimMakeChannel(interp, fd, argv[1], "aio.handle%ld", 0, flags); + if (af) { + /* filehandles created by open are not tainted by default */ + JimAioSetTaint(af, 0, 0); + return JIM_OK; + } + return JIM_ERR; } #if defined(JIM_SSL) && !defined(JIM_BOOTSTRAP) @@ -2393,6 +2624,12 @@ static SSL_CTX *JimAioSslCtx(Jim_Interp *interp) } #endif /* JIM_BOOTSTRAP */ +static void JimAioSetTaint(AioFile *af, int taintsource, int taintsink) +{ + af->taintsource = taintsource; + af->taintsink = taintsink; +} + /** * Creates a channel for fd/filename. * @@ -2448,8 +2685,19 @@ static AioFile *JimMakeChannel(Jim_Interp *interp, int fd, Jim_Obj *filename, /* Create an empty write buf */ af->writebuf = Jim_NewStringObj(interp, NULL, 0); Jim_IncrRefCount(af->writebuf); + af->wbuf_limit = AIO_DEFAULT_WBUF_LIMIT; + af->rbuf_len = AIO_DEFAULT_RBUF_LEN; + /* Don't allocate rbuf or readbuf until we need it */ - Jim_CreateCommand(interp, buf, JimAioSubCmdProc, af, JimAioDelProc); + /* By default, all channels are JIM_TAINT_STD for input and output. */ + if (!(flags & AIO_NOTAINT)) { + JimAioSetTaint(af, JIM_TAINT_STD, JIM_TAINT_STD); + } + Jim_RegisterCommand(interp, cmdname, + JimAioSubCmdProc, JimAioDelProc, + NULL, /* usage comes from -help */ + NULL, /* no help */ + 0, -1, JIM_CMD_ISCHANNEL, af); /* Note that the command must use the global namespace, even if * the current namespace is something different @@ -2500,10 +2748,6 @@ static int JimCreatePipe(Jim_Interp *interp, Jim_Obj *filenameObj, int flags) /* Note that if you want -noclose, use "socket -noclose pipe" instead */ static int JimAioPipeCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } return JimCreatePipe(interp, argv[0], 0); } #endif @@ -2514,11 +2758,6 @@ static int JimAioOpenPtyCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar int p[2]; char path[MAXPATHLEN]; - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } - if (openpty(&p[0], &p[1], path, NULL, NULL) != 0) { JimAioSetError(interp, NULL); return JIM_ERR; @@ -2575,7 +2814,6 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int do_listen = 0; int family = PF_INET; int type = SOCK_STREAM; - Jim_Obj *argv0 = argv[0]; int ipv6 = 0; int async = 0; int flags = 0; @@ -2616,9 +2854,7 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) } if (argc < 2) { - wrongargs: - Jim_WrongNumArgs(interp, 1, &argv0, "?-async? ?-ipv6? socktype ?address?"); - return JIM_ERR; + return JIM_USAGE; } if (Jim_GetEnum(interp, argv[1], socktypes, &socktype, "socktype", JIM_ERRMSG) != JIM_OK) { @@ -2638,7 +2874,7 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int p[2]; if (addr || ipv6) { - goto wrongargs; + return JIM_USAGE; } if (socketpair(PF_UNIX, SOCK_STREAM, 0, p) < 0) { @@ -2653,7 +2889,7 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) #if defined(HAVE_PIPE) if (socktype == SOCK_STREAM_PIPE) { if (addr || ipv6) { - goto wrongargs; + return JIM_USAGE; } return JimCreatePipe(interp, argv[1], flags); } @@ -2668,14 +2904,14 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) case SOCK_STREAM_CLIENT: if (addr == NULL) { - goto wrongargs; + return JIM_USAGE; } connect_addr = addr; break; case SOCK_STREAM_SERVER: if (addr == NULL) { - goto wrongargs; + return JIM_USAGE; } bind_addr = addr; reuse = 1; @@ -2684,7 +2920,7 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) case SOCK_DGRAM_SERVER: if (addr == NULL) { - goto wrongargs; + return JIM_USAGE; } bind_addr = addr; type = SOCK_DGRAM; @@ -2694,7 +2930,7 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) #if UNIX_SOCKETS case SOCK_UNIX: if (addr == NULL) { - goto wrongargs; + return JIM_USAGE; } connect_addr = addr; family = PF_UNIX; @@ -2721,7 +2957,7 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) case SOCK_UNIX_SERVER: if (addr == NULL) { - goto wrongargs; + return JIM_USAGE; } bind_addr = addr; family = PF_UNIX; @@ -2730,7 +2966,7 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) case SOCK_UNIX_DGRAM_SERVER: if (addr == NULL) { - goto wrongargs; + return JIM_USAGE; } bind_addr = addr; type = SOCK_DGRAM; @@ -2740,7 +2976,7 @@ static int JimAioSockCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) #ifdef HAVE_OPENPTY case SOCK_STREAM_PTY: if (addr || ipv6) { - goto wrongargs; + return JIM_USAGE; } return JimAioOpenPtyCommand(interp, 1, &argv[1]); #endif @@ -2806,11 +3042,6 @@ static int JimAioLoadSSLCertsCommand(Jim_Interp *interp, int argc, Jim_Obj *cons { SSL_CTX *ssl_ctx; - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "dir"); - return JIM_ERR; - } - ssl_ctx = JimAioSslCtx(interp); if (!ssl_ctx) { return JIM_ERR; @@ -2823,27 +3054,33 @@ static int JimAioLoadSSLCertsCommand(Jim_Interp *interp, int argc, Jim_Obj *cons } #endif /* JIM_BOOTSTRAP */ -int Jim_aioInit(Jim_Interp *interp) +/* Create filehandles for stdin, stdout and stderr */ +static void JimMakeStdioChannel(Jim_Interp *interp, FILE *fh, const char *name, unsigned flags) { - if (Jim_PackageProvide(interp, "aio", "1.0", JIM_ERRMSG)) - return JIM_ERR; + /* Note: this can't fail */ + AioFile *af = JimMakeChannel(interp, fileno(fh), NULL, name, 0, AIO_KEEPOPEN | flags); + JimAioSetTaint(af, 0, 0); +} +int Jim_aioInit(Jim_Interp *interp) +{ + Jim_PackageProvideCheck(interp, "aio"); #if defined(JIM_SSL) - Jim_CreateCommand(interp, "load_ssl_certs", JimAioLoadSSLCertsCommand, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "load_ssl_certs", "dir", 1, 1, JimAioLoadSSLCertsCommand); #endif - Jim_CreateCommand(interp, "open", JimAioOpenCommand, NULL, NULL); + Jim_RegisterCmd(interp, "open", "filename ?-noclose? ?mode?", 1, 3, JimAioOpenCommand, NULL, NULL, JIM_CMD_NOTAINT); #ifdef HAVE_SOCKETS - Jim_CreateCommand(interp, "socket", JimAioSockCommand, NULL, NULL); + Jim_RegisterCmd(interp, "socket", "?-async? ?-ipv6? socktype ?address?", 1, 4, JimAioSockCommand, NULL, NULL, JIM_CMD_NOTAINT); #endif #ifdef HAVE_PIPE - Jim_CreateCommand(interp, "pipe", JimAioPipeCommand, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "pipe", "", 0, 0, JimAioPipeCommand); #endif /* Create filehandles for stdin, stdout and stderr */ - JimMakeChannel(interp, fileno(stdin), NULL, "stdin", 0, AIO_KEEPOPEN); - JimMakeChannel(interp, fileno(stdout), NULL, "stdout", 0, AIO_KEEPOPEN); - JimMakeChannel(interp, fileno(stderr), NULL, "stderr", 0, AIO_KEEPOPEN | AIO_WBUF_NONE); + JimMakeStdioChannel(interp, stdin, "stdin", 0); + JimMakeStdioChannel(interp, stdout, "stdout", 0); + JimMakeStdioChannel(interp, stderr, "stderr", AIO_WBUF_NONE); return JIM_OK; } diff --git a/jim-array.c b/jim-array.c index a21099d..a43d89f 100644 --- a/jim-array.c +++ b/jim-array.c @@ -260,6 +260,6 @@ static const jim_subcmd_type array_command_table[] = { int Jim_arrayInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "array"); - Jim_CreateCommand(interp, "array", Jim_SubCmdProc, (void *)array_command_table, NULL); + Jim_RegisterSubCmd(interp, "array", array_command_table, NULL); return JIM_OK; } diff --git a/jim-clock.c b/jim-clock.c index 866ed58..ac67996 100644 --- a/jim-clock.c +++ b/jim-clock.c @@ -213,6 +213,6 @@ static const jim_subcmd_type clock_command_table[] = { int Jim_clockInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "clock"); - Jim_CreateCommand(interp, "clock", Jim_SubCmdProc, (void *)clock_command_table, NULL); + Jim_RegisterSubCmd(interp, "clock", clock_command_table, NULL); return JIM_OK; } diff --git a/jim-eventloop.c b/jim-eventloop.c index 84cba71..a3880ad 100644 --- a/jim-eventloop.c +++ b/jim-eventloop.c @@ -564,20 +564,24 @@ static void JimELAssocDataDeleProc(Jim_Interp *interp, void *data) static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { Jim_EventLoop *eventLoop = Jim_CmdPrivData(interp); - Jim_Obj *oldValue; + Jim_Obj *oldValue = NULL; + Jim_Obj *scriptObjPtr = NULL; int rc; int signal = 0; - if (argc == 3 && Jim_CompareStringImmediate(interp, argv[1], "-signal")) { + if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-signal")) { signal++; } - if (argc - signal != 2) { - Jim_WrongNumArgs(interp, 1, argv, "?-signal? name"); - return JIM_ERR; + if (argc - signal == 3) { + scriptObjPtr = argv[2 + signal]; + } + else if (argc - signal != 2) { + return JIM_USAGE; } oldValue = Jim_GetGlobalVariable(interp, argv[1 + signal], JIM_NONE); + if (oldValue) { Jim_IncrRefCount(oldValue); } @@ -591,6 +595,8 @@ static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) eventLoop->suppress_bgerror = 0; while ((rc = Jim_ProcessEvents(interp, JIM_ALL_EVENTS)) >= 0) { + Jim_Obj *currValue; + if (signal && interp->sigmask) { /* vwait -signal and handled signals were received, so transfer them * to ignored signals so that 'signal check -clear' will return them. @@ -603,7 +609,7 @@ static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) interp->sigmask = 0; break; } - Jim_Obj *currValue; + currValue = Jim_GetGlobalVariable(interp, argv[1 + signal], JIM_NONE); /* Stop the loop if the vwait-ed variable changed value, * or if was unset and now is set (or the contrary) @@ -615,6 +621,16 @@ static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_CheckSignal(interp)) { break; } + if (scriptObjPtr) { + /* Stop the loop if a provided script returns BREAK or ERR */ + int retval = Jim_EvalObj(interp, scriptObjPtr); + if (retval == JIM_ERR || retval == JIM_BREAK) { + if (retval == JIM_ERR) { + rc = -2; + } + break; + } + } } if (oldValue) Jim_DecrRefCount(interp, oldValue); @@ -640,9 +656,8 @@ static int JimELUpdateCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv if (argc == 1) { flags = JIM_ALL_EVENTS; } - else if (argc > 2 || Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { - Jim_WrongNumArgs(interp, 1, argv, "?idletasks?"); - return JIM_ERR; + else if (argc > 2 || Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_USAGE; } eventLoop->suppress_bgerror = 0; @@ -679,11 +694,6 @@ static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) enum { AFTER_CANCEL, AFTER_INFO, AFTER_IDLE, AFTER_RESTART, AFTER_EXPIRE, AFTER_CREATE }; int option = AFTER_CREATE; - - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "option ?arg ...?"); - return JIM_ERR; - } if (Jim_GetDouble(interp, argv[1], &ms) != JIM_OK) { if (Jim_GetEnum(interp, argv[1], options, &option, "argument", JIM_ERRMSG) != JIM_OK) { return JIM_ERR; @@ -792,9 +802,9 @@ int Jim_eventloopInit(Jim_Interp *interp) Jim_SetAssocData(interp, "eventloop", JimELAssocDataDeleProc, eventLoop); - Jim_CreateCommand(interp, "vwait", JimELVwaitCommand, eventLoop, NULL); - Jim_CreateCommand(interp, "update", JimELUpdateCommand, eventLoop, NULL); - Jim_CreateCommand(interp, "after", JimELAfterCommand, eventLoop, NULL); + Jim_RegisterCmd(interp, "vwait", "?-signal? name ?script?", 1, 3, JimELVwaitCommand, NULL, eventLoop, 0); + Jim_RegisterCmd(interp, "update", "?idletasks?", 0, 1, JimELUpdateCommand, NULL, eventLoop, 0); + Jim_RegisterCmd(interp, "after", "option ?arg ...?", 1, -1, JimELAfterCommand, NULL, eventLoop, 0); return JIM_OK; } @@ -80,7 +80,7 @@ static int Jim_ExecCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int Jim_execInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "exec"); - Jim_CreateCommand(interp, "exec", Jim_ExecCmd, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "exec", "arg ?arg ...? ?&?", 1, -1, Jim_ExecCmd); return JIM_OK; } #else @@ -97,8 +97,8 @@ 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, - phandle_t **pidArrayPtr, int *inPipePtr, int *outPipePtr, int *errFilePtr); +static int JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, phandle_t **pidArrayPtr, + int *outPipePtr, int *errFilePtr); static void JimDetachPids(struct WaitInfoTable *table, int numPids, const phandle_t *pidPtr); static int JimCleanupChildren(Jim_Interp *interp, int numPids, phandle_t *pidPtr, Jim_Obj *errStrObj); static int Jim_WaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv); @@ -333,7 +333,7 @@ static struct WaitInfoTable *JimAllocWaitInfoTable(void) struct WaitInfoTable *table = Jim_Alloc(sizeof(*table)); table->info = NULL; table->size = table->used = 0; - table->refcount = 1; + table->refcount = 0; return table; } @@ -383,7 +383,7 @@ static int Jim_ExecCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int i; argc--; - numPids = JimCreatePipeline(interp, argc - 1, argv + 1, &pidPtr, NULL, NULL, NULL); + numPids = JimCreatePipeline(interp, argc - 1, argv + 1, &pidPtr, NULL, NULL); if (numPids < 0) { return JIM_ERR; } @@ -402,7 +402,7 @@ static int Jim_ExecCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) * Create the command's pipeline. */ numPids = - JimCreatePipeline(interp, argc - 1, argv + 1, &pidPtr, NULL, &outputId, &errorId); + JimCreatePipeline(interp, argc - 1, argv + 1, &pidPtr, &outputId, &errorId); if (numPids < 0) { return JIM_ERR; @@ -503,6 +503,7 @@ static void JimDetachPids(struct WaitInfoTable *table, int numPids, const phandl } /* Use 'name getfd' to get the file descriptor associated with channel 'name' + * and dup() the resulting file descriptor. * Returns the file descriptor or -1 on error */ static int JimGetChannelFd(Jim_Interp *interp, const char *name) @@ -515,7 +516,7 @@ static int JimGetChannelFd(Jim_Interp *interp, const char *name) if (Jim_EvalObjVector(interp, 2, objv) == JIM_OK) { jim_wide fd; if (Jim_GetWide(interp, Jim_GetResult(interp), &fd) == JIM_OK) { - return fd; + return dup(fd); } } return -1; @@ -594,8 +595,7 @@ static int Jim_WaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) nohang = 1; } if (argc != nohang + 2) { - Jim_WrongNumArgs(interp, 1, argv, "?-nohang? ?pid?"); - return JIM_ERR; + return JIM_USAGE; } if (Jim_GetLong(interp, argv[nohang + 1], &pid) != JIM_OK) { return JIM_ERR; @@ -613,6 +613,10 @@ static int Jim_WaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) */ pid = phandle; } + else if (phandle == 0) { + /* Child still running */ + pid = 0; + } #endif errCodeObj = JimMakeErrorCode(interp, pid, status, NULL); @@ -627,46 +631,204 @@ static int Jim_WaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) static int Jim_PidCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); + Jim_SetResultInt(interp, (jim_wide)getpid()); + return JIM_OK; +} + +#define JIM_ETT_IN 0x0001 /* < */ +#define JIM_ETT_OUT 0x0002 /* > */ +#define JIM_ETT_ERR 0x0004 /* 2> */ +#define JIM_ETT_PIPE 0x0008 /* | */ + +#define JIM_ETT_NOARG 0x0010 /* does not accept an additional argument */ +#define JIM_ETT_APPEND 0x0020 /* append to output */ +#define JIM_ETT_STR 0x0040 /* arg is a literal */ +#define JIM_ETT_DUPERR 0x0080 /* dup output to err */ +#define JIM_ETT_HANDLE 0x0100 /* arg is a filehandle */ + +#define JIM_ETT_CMD 0xF000 +#define JIM_ETT_BAD 0xF001 + +struct redir_type_t { + const char *prefix; + unsigned flags; +}; + +/* These need to be sorted by length, most specific first */ +static const struct redir_type_t redir_types[] = { + { "<<@", JIM_ETT_IN | JIM_ETT_HANDLE | JIM_ETT_STR }, + { "<<", JIM_ETT_IN | JIM_ETT_STR }, + { "<@", JIM_ETT_IN | JIM_ETT_HANDLE }, + { "<", JIM_ETT_IN }, + + { "2>>", JIM_ETT_ERR | JIM_ETT_APPEND }, + { "2>@", JIM_ETT_ERR | JIM_ETT_HANDLE }, + { "2>", JIM_ETT_ERR }, + + { ">>&", JIM_ETT_OUT | JIM_ETT_APPEND | JIM_ETT_DUPERR }, + { ">>", JIM_ETT_OUT | JIM_ETT_APPEND }, + { ">&@", JIM_ETT_OUT | JIM_ETT_HANDLE | JIM_ETT_DUPERR }, + { ">@", JIM_ETT_OUT | JIM_ETT_HANDLE }, + { ">&", JIM_ETT_OUT | JIM_ETT_DUPERR }, + { ">", JIM_ETT_OUT }, + + { "|&", JIM_ETT_PIPE | JIM_ETT_DUPERR }, + { "|", JIM_ETT_PIPE }, + { NULL } +}; + +static unsigned JimExecClassifyArg(const char *arg) +{ + int i; + for (i = 0; redir_types[i].prefix; i++) { + int len = strlen(redir_types[i].prefix); + if (strncmp(arg, redir_types[i].prefix, len) == 0) { + if (strlen(arg) > len) { + if (redir_types[i].flags & JIM_ETT_NOARG) { + /* error - no arg expected */ + return JIM_ETT_BAD; + } + return redir_types[i].flags; + } + /* Token doesn't contain an arg */ + return redir_types[i].flags | JIM_ETT_NOARG; + } + } + return JIM_ETT_CMD; +} + +/** + * Parses the exec pipeline in TIP424 format into two lists, cmdList and redirectList. + * (These must start as empty lists) + * + * Returns JIM_OK if ok or JIM_ERR on error. + */ +static int JimParsePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, Jim_Obj *cmdList, Jim_Obj *redirectList) +{ + int i; + /* Add an initial empty commandlist */ + int first = 1; + const char *arg = NULL; + + for (i = 0; i < argc; i++) { + unsigned ett; + if (first) { + if (Jim_ListLength(interp, argv[i]) == 0) { + Jim_SetResultString(interp, "empty command list", -1); + return JIM_ERR; + } + Jim_ListAppendElement(interp, cmdList, argv[i]); + first = 0; + continue; + } + /* Remaining items should be redirections or | */ + arg = Jim_String(argv[i]); + ett = JimExecClassifyArg(arg); + if (ett == JIM_ETT_BAD || ett == JIM_ETT_CMD) { + Jim_SetResultFormatted(interp, "invalid redirection %s", arg); + return JIM_ERR; + } + if (ett & JIM_ETT_PIPE) { + Jim_ListAppendElement(interp, cmdList, argv[i]); + first = 1; + continue; + } + Jim_ListAppendElement(interp, redirectList, argv[i]); + if ((ett & JIM_ETT_NOARG)) { + /* This means we need an arg */ + if (i >= argc - 1) { + /* This is an error */ + Jim_SetResultFormatted(interp, "can't specify \"%#s\" as last word in command", argv[i]); + return -1; + } + i++; + Jim_ListAppendElement(interp, redirectList, argv[i]); + } + } + + if (first) { + if (Jim_ListLength(interp, cmdList)) { + Jim_SetResultFormatted(interp, "cmdlist required after %s", arg); + } + else { + Jim_SetResultString(interp, "cmdlist is required", -1); + } return JIM_ERR; } - Jim_SetResultInt(interp, (jim_wide)getpid()); return JIM_OK; } -/* - *---------------------------------------------------------------------- - * - * JimCreatePipeline -- - * - * Given an argc/argv array, instantiate a pipeline of processes - * as described by the argv. - * - * Results: - * The return value is a count of the number of new processes - * created, or -1 if an error occurred while creating the pipeline. - * *pidArrayPtr is filled in with the address of a dynamically - * allocated array giving the ids of all of the processes. It - * is up to the caller to free this array when it isn't needed - * anymore. If inPipePtr is non-NULL, *inPipePtr is filled in - * with the file id for the input pipe for the pipeline (if any): - * the caller must eventually close this file. If outPipePtr - * isn't NULL, then *outPipePtr is filled in with the file id - * for the output pipe from the pipeline: the caller must close - * this file. If errFilePtr isn't NULL, then *errFilePtr is filled - * with a file id that may be used to read error output after the - * pipeline completes. +/** + * Parses the exec pipeline in legacy format into two lists, cmdList and redirectList. + * (These must start as empty lists) * - * Side effects: - * Processes and pipes are created. + * cmdList contains a list of {cmdlist ?sep cmdlist ...? } + * i.e. pairs of cmdlist (a list of {command arg...}) and a separator: | or |& + * with the separator missing after the last command list. * - *---------------------------------------------------------------------- + * Returns JIM_OK if ok or JIM_ERR on error. */ -static int -JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, phandle_t **pidArrayPtr, - int *inPipePtr, int *outPipePtr, int *errFilePtr) +static int JimParsePipelineLegacy(Jim_Interp *interp, int argc, Jim_Obj *const *argv, Jim_Obj *cmdList, Jim_Obj *redirectList) +{ + int i; + /* Add an initial empty commandlist */ + Jim_Obj *cmdObj = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, cmdList, cmdObj); + const char *arg = NULL; + + for (i = 0; i < argc; i++) { + arg = Jim_String(argv[i]); + unsigned ett = JimExecClassifyArg(arg); + if (ett == JIM_ETT_BAD) { + Jim_SetResultFormatted(interp, "invalid: %s", arg); + return JIM_ERR; + } + if (ett == JIM_ETT_CMD) { + /* Add to the current command */ + Jim_ListAppendElement(interp, cmdObj, argv[i]); + continue; + } + if (ett & JIM_ETT_PIPE) { + if (Jim_ListLength(interp, cmdObj) == 0) { + goto missing_cmd; + } + /* Add this separator */ + Jim_ListAppendElement(interp, cmdList, argv[i]); + /* Now start a new command list */ + cmdObj = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, cmdList, cmdObj); + continue; + } + Jim_ListAppendElement(interp, redirectList, argv[i]); + if ((ett & JIM_ETT_NOARG)) { + /* This means we need an arg */ + if (i >= argc - 1) { + /* This is an error */ + Jim_SetResultFormatted(interp, "can't specify \"%#s\" as last word in command", argv[i]); + return -1; + } + i++; + Jim_ListAppendElement(interp, redirectList, argv[i]); + } + } + + if (Jim_ListLength(interp, cmdObj) == 0) { +missing_cmd: + if (arg && *arg == '|') { + Jim_SetResultString(interp, "illegal use of | or |& in command", -1); + } + else { + Jim_SetResultString(interp, "didn't specify command to execute", -1); + } + return JIM_ERR; + } + + return JIM_OK; +} + +static int JimExecPipeline(Jim_Interp *interp, Jim_Obj *cmdList, Jim_Obj *redirectList, + phandle_t **pidArrayPtr, int *outPipePtr, int *errFilePtr) { phandle_t *pidPtr = NULL; /* Points to alloc-ed array holding all * the pids of child processes. */ @@ -679,9 +841,9 @@ JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, phandle_t * from stdin/pipe. */ int input_len = 0; /* Length of input, if relevant */ -#define FILE_NAME 0 /* input/output: filename */ +#define FILE_NAME 0 /* input/output: filename or @filehandle */ #define FILE_APPEND 1 /* output only: filename, append */ -#define FILE_HANDLE 2 /* input/output: filehandle */ +#define FILE_HANDLE 2 /* input/output: @ filehandle */ #define FILE_TEXT 3 /* input only: input is actual text */ int inputFile = FILE_NAME; /* 1 means input is name of input file. @@ -720,9 +882,6 @@ JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, phandle_t * in pipeline (could be file or pipe). * -1 means use stdout. */ int pipeIds[2]; /* File ids for pipe that's being created. */ - int firstArg, lastArg; /* Indexes of first and last arguments in - * current command. */ - int lastBar; int i; phandle_t phandle; char **save_environ; @@ -731,13 +890,6 @@ JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, phandle_t #endif struct WaitInfoTable *table = Jim_CmdPrivData(interp); - /* Holds the args which will be used to exec */ - char **arg_array = Jim_Alloc(sizeof(*arg_array) * (argc + 1)); - int arg_count = 0; - - if (inPipePtr != NULL) { - *inPipePtr = -1; - } if (outPipePtr != NULL) { *outPipePtr = -1; } @@ -746,105 +898,72 @@ JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, phandle_t } pipeIds[0] = pipeIds[1] = -1; - /* - * First, scan through all the arguments to figure out the structure - * of the pipeline. Count the number of distinct processes (it's the - * number of "|" arguments). If there are "<", "<<", or ">" arguments - * then make note of input and output redirection and remove these - * arguments and the arguments that follow them. + /* Now interpet the redirection list */ - 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++; + int redir_len = Jim_ListLength(interp, redirectList); + for (i = 0; i < redir_len; i++) { + int len; + int item_len; + Jim_Obj *redirObj = Jim_ListGetIndex(interp, redirectList, i); + const char *arg = Jim_GetString(redirObj, &len); + unsigned ett = JimExecClassifyArg(arg); + const char *item; + int type = FILE_NAME; + if ((ett & JIM_ETT_NOARG) == 0) { + /* No separate arg. Need to skip over the appropriate number or redirection chars */ + item = arg + 1; + if (ett & JIM_ETT_HANDLE) { + item++; } - if (*output == '&') { - /* Redirect stderr too */ - output++; - dup_error = 1; + if (ett & JIM_ETT_APPEND) { + item++; } - if (*output == '@') { - outputFile = FILE_HANDLE; - output++; + if (ett & JIM_ETT_DUPERR) { + item++; } - if (!*output && ++i < argc) { - output = Jim_String(argv[i]); + if (ett & JIM_ETT_ERR) { + item++; } - 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]); + if (ett & JIM_ETT_STR) { + type = FILE_TEXT; + item++; } + item_len = len - (item - arg); } 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++; + /* separate arg, so fetch it */ + i++; + item = Jim_GetString(Jim_ListGetIndex(interp, redirectList, i), &item_len); + } + /* Figure out the type */ + if (ett & JIM_ETT_HANDLE) { + type = FILE_HANDLE; + } + if (ett & JIM_ETT_APPEND) { + type = FILE_APPEND; + } + if (ett & JIM_ETT_STR) { + type = FILE_TEXT; + } + if (ett & JIM_ETT_IN) { + input = item; + input_len = item_len; + inputFile = type; + } + else if (ett & JIM_ETT_OUT) { + output = item; + outputFile = type; + if (ett & JIM_ETT_DUPERR) { + error = output; + errorFile = outputFile; } - /* Either |, |& or a "normal" arg, so store it in the arg array */ - 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; + else if (ett & JIM_ETT_ERR) { + error = item; + errorFile = type; } } - if (arg_count == 0) { - Jim_SetResultString(interp, "didn't specify command to execute", -1); -badargs: - Jim_Free(arg_array); - return -1; - } - /* Must do this before vfork(), so do it now */ save_environ = JimSaveEnv(JimBuildEnv(interp)); @@ -870,12 +989,10 @@ badargs: Jim_Lseek(inputId, 0L, SEEK_SET); } else if (inputFile == FILE_HANDLE) { - int fd = JimGetChannelFd(interp, input); - - if (fd < 0) { + inputId = JimGetChannelFd(interp, input); + if (inputId < 0) { goto error; } - inputId = dup(fd); } else { /* @@ -888,15 +1005,6 @@ badargs: } } } - 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; - } /* * Set up the redirected output sink for the pipeline from one @@ -904,11 +1012,10 @@ badargs: */ if (output != NULL) { if (outputFile == FILE_HANDLE) { - int fd = JimGetChannelFd(interp, output); - if (fd < 0) { + lastOutputId = JimGetChannelFd(interp, output); + if (lastOutputId < 0) { goto error; } - lastOutputId = dup(fd); } else { /* @@ -933,11 +1040,12 @@ badargs: *outPipePtr = pipeIds[0]; pipeIds[0] = pipeIds[1] = -1; } + /* If we are redirecting stderr with 2>filename or 2>@fileId, then we ignore errFilePtr */ if (error != NULL) { if (errorFile == FILE_HANDLE) { if (strcmp(error, "1") == 0) { - /* Special 2>@1 */ + /* Special 2>@1 so stderr goes to the pipe output too */ if (lastOutputId != -1) { errorId = dup(lastOutputId); } @@ -947,11 +1055,10 @@ badargs: } } if (errorId == -1) { - int fd = JimGetChannelFd(interp, error); - if (fd < 0) { + errorId = JimGetChannelFd(interp, error); + if (errorId < 0) { goto error; } - errorId = dup(fd); } } else { @@ -982,59 +1089,59 @@ badargs: } /* - * Scan through the argc array, forking off a process for each - * group of arguments between "|" arguments. + * Iterate over cmdList, forking off a process for each + * cmdlist */ - + int cmd_list_size = Jim_ListLength(interp, cmdList); + cmdCount = (cmd_list_size + 1) / 2; pidPtr = Jim_Alloc(cmdCount * sizeof(*pidPtr)); - 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; - } + for (i = 0; i < cmd_list_size; ) { + char **arg_array; + int j; + int origErrorId = errorId; + Jim_Obj *cmdObj = Jim_ListGetIndex(interp, cmdList, i++); + int cmd_len = Jim_ListLength(interp, cmdObj); + Jim_Obj *sepObj = NULL; + if (i < cmd_list_size - 1) { + sepObj = Jim_ListGetIndex(interp, cmdList, i++); } - if (lastArg == firstArg) { - Jim_SetResultString(interp, "missing command to exec", -1); - goto error; + /* Build exec array */ + arg_array = Jim_Alloc((cmd_len + 1) * sizeof(*arg_array)); + for (j = 0; j < cmd_len; j++) { + arg_array[j] = (char *)Jim_String(Jim_ListGetIndex(interp, cmdObj, j)); } + arg_array[j] = NULL; - /* Replace | with NULL for execv() */ - arg_array[lastArg] = NULL; - if (lastArg == arg_count) { + if (sepObj == NULL) { outputId = lastOutputId; lastOutputId = -1; } else { if (pipe(pipeIds) != 0) { Jim_SetResultErrno(interp, "couldn't create pipe"); + Jim_Free(arg_array); goto error; } outputId = pipeIds[1]; } /* Need to do this before vfork() */ - if (pipe_dup_err) { + if (sepObj && Jim_CompareStringImmediate(interp, sepObj, "|&")) { errorId = outputId; } /* Now fork the child */ #ifdef __MINGW32__ - phandle = JimStartWinProcess(interp, &arg_array[firstArg], save_environ, inputId, outputId, errorId); + phandle = JimStartWinProcess(interp, &arg_array[0], save_environ, inputId, outputId, errorId); if (phandle == JIM_BAD_PHANDLE) { - Jim_SetResultFormatted(interp, "couldn't exec \"%s\"", arg_array[firstArg]); + Jim_SetResultFormatted(interp, "couldn't exec \"%s\"", arg_array[0]); goto error; } #else - i = strlen(arg_array[firstArg]); + int argv0_len = strlen(arg_array[0]); #ifdef HAVE_EXECVPE child_environ = Jim_GetEnviron(); @@ -1083,10 +1190,10 @@ badargs: close(lastOutputId); } - execvpe(arg_array[firstArg], &arg_array[firstArg], child_environ); + execvpe(arg_array[0], arg_array, child_environ); if (write(fileno(stderr), "couldn't exec \"", 15) && - write(fileno(stderr), arg_array[firstArg], i) && + write(fileno(stderr), arg_array[0], argv0_len) && write(fileno(stderr), "\"\n", 2)) { /* nothing */ } @@ -1102,6 +1209,7 @@ badargs: #endif /* parent */ + Jim_Free(arg_array); /* * Enlarge the wait table if there isn't enough space for a new @@ -1116,7 +1224,7 @@ badargs: table->info[table->used].flags = 0; table->used++; - pidPtr[numPids] = phandle; + pidPtr[numPids++] = phandle; /* Restore in case of pipe_dup_err */ errorId = origErrorId; @@ -1151,7 +1259,6 @@ badargs: if (errorId != -1) { close(errorId); } - Jim_Free(arg_array); JimRestoreEnv(save_environ); @@ -1164,10 +1271,6 @@ badargs: */ error: - if ((inPipePtr != NULL) && (*inPipePtr != -1)) { - close(*inPipePtr); - *inPipePtr = -1; - } if ((outPipePtr != NULL) && (*outPipePtr != -1)) { close(*outPipePtr); *outPipePtr = -1; @@ -1197,6 +1300,61 @@ badargs: /* *---------------------------------------------------------------------- * + * JimCreatePipeline -- + * + * Given an argc/argv array, instantiate a pipeline of processes + * as described by the argv. + * + * Results: + * The return value is a count of the number of new processes + * created, or -1 if an error occurred while creating the pipeline. + * *pidArrayPtr is filled in with the address of a dynamically + * allocated array giving the ids of all of the processes. It + * is up to the caller to free this array when it isn't needed + * anymore. If outPipePtr + * isn't NULL, then *outPipePtr is filled in with the file id + * for the output pipe from the pipeline: the caller must close + * this file. If errFilePtr isn't NULL, then *errFilePtr is filled + * with a file id that may be used to read error output after the + * pipeline completes. + * + * Side effects: + * Processes and pipes are created. + * + *---------------------------------------------------------------------- + */ +static int +JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, phandle_t **pidArrayPtr, + int *outPipePtr, int *errFilePtr) +{ + int rc = -1; + int ret; + + Jim_Obj *cmdList = Jim_NewListObj(interp, NULL, 0); + Jim_Obj *redirectList = Jim_NewListObj(interp, NULL, 0); + Jim_IncrRefCount(cmdList); + Jim_IncrRefCount(redirectList); + + if (argc > 1 && Jim_CompareStringImmediate(interp, argv[0], "|")) { + /* TIP424 exec format */ + ret = JimParsePipeline(interp, argc - 1, argv + 1, cmdList, redirectList); + } + else { + /* legacy exec format */ + ret = JimParsePipelineLegacy(interp, argc, argv, cmdList, redirectList); + } + if (ret == JIM_OK) { + /* OK, try to exec */ + rc = JimExecPipeline(interp, cmdList, redirectList, pidArrayPtr, outPipePtr, errFilePtr); + } + Jim_DecrRefCount(interp, cmdList); + Jim_DecrRefCount(interp, redirectList); + return rc; +} + +/* + *---------------------------------------------------------------------- + * * JimCleanupChildren -- * * This is a utility procedure used to wait for child processes @@ -1242,10 +1400,11 @@ int Jim_execInit(Jim_Interp *interp) Jim_PackageProvideCheck(interp, "exec"); waitinfo = JimAllocWaitInfoTable(); - Jim_CreateCommand(interp, "exec", Jim_ExecCmd, waitinfo, JimFreeWaitInfoTable); + Jim_RegisterCmd(interp, "exec", "arg ?arg ...? ?&?", 1, -1, Jim_ExecCmd, JimFreeWaitInfoTable, waitinfo, JIM_CMD_NOTAINT); + waitinfo->refcount++; + Jim_RegisterCmd(interp, "wait", "?-nohang? ?pid?", 0, 2, Jim_WaitCommand, JimFreeWaitInfoTable, waitinfo, 0); waitinfo->refcount++; - Jim_CreateCommand(interp, "wait", Jim_WaitCommand, waitinfo, JimFreeWaitInfoTable); - Jim_CreateCommand(interp, "pid", Jim_PidCommand, 0, 0); + Jim_RegisterSimpleCmd(interp, "pid", "", 0, 0, Jim_PidCommand); return JIM_OK; } @@ -67,14 +67,6 @@ #define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) #endif -# ifndef MAXPATHLEN -# ifdef PATH_MAX -# define MAXPATHLEN PATH_MAX -# else -# define MAXPATHLEN JIM_PATH_LEN -# endif -# endif - #if defined(__MINGW32__) || defined(__MSYS__) || defined(_MSC_VER) #define ISWINDOWS 1 /* Even if we have symlink it isn't compatible enought to use */ @@ -568,8 +560,8 @@ static int mkdir_all(char *path) /* Create the parent and try again */ continue; } - /* Maybe it already exists as a directory */ - if (errno == EEXIST) { + /* Maybe it already exists as a directory. MorphOS can return ENOTDIR instead of EEXIST */ + if (errno == EEXIST || errno == ENOTDIR) { jim_stat_t sb; if (Jim_Stat(path, &sb) == 0 && S_ISDIR(sb.st_mode)) { @@ -1007,6 +999,7 @@ static const jim_subcmd_type file_command_table[] = { file_cmd_delete, 1, -1, + JIM_MODFLAG_NOTAINT, /* Description: Deletes the files or directories (must be empty unless -force) */ }, { "mkdir", @@ -1014,6 +1007,7 @@ static const jim_subcmd_type file_command_table[] = { file_cmd_mkdir, 1, -1, + JIM_MODFLAG_NOTAINT, /* Description: Creates the directories */ }, { "tempfile", @@ -1021,6 +1015,7 @@ static const jim_subcmd_type file_command_table[] = { file_cmd_tempfile, 0, 1, + JIM_MODFLAG_NOTAINT, /* Description: Creates a temporary filename */ }, { "rename", @@ -1028,6 +1023,7 @@ static const jim_subcmd_type file_command_table[] = { file_cmd_rename, 2, 3, + JIM_MODFLAG_NOTAINT, /* Description: Renames a file */ }, #if defined(HAVE_LINK) && defined(HAVE_SYMLINK) @@ -1106,14 +1102,7 @@ static const jim_subcmd_type file_command_table[] = { 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]); + const char *path = Jim_String(argv[1]); if (chdir(path) != 0) { Jim_SetResultFormatted(interp, "couldn't change working directory to \"%s\": %s", path, @@ -1142,8 +1131,8 @@ static int Jim_PwdCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int Jim_fileInit(Jim_Interp *interp) { 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); + Jim_RegisterSubCmd(interp, "file", file_command_table, NULL); + Jim_RegisterSimpleCmd(interp, "pwd", "", 0, 0, Jim_PwdCmd); + Jim_RegisterCmd(interp, "cd", "dirname", 1, 1, Jim_CdCmd, NULL, NULL, JIM_CMD_NOTAINT); return JIM_OK; } diff --git a/jim-history.c b/jim-history.c index 076fd0b..39ddf5d 100644 --- a/jim-history.c +++ b/jim-history.c @@ -24,7 +24,6 @@ static int history_cmd_getline(Jim_Interp *interp, int argc, Jim_Obj *const *arg /* Returns the length of the string if varName was specified */ if (argc == 2) { if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) { - Jim_FreeNewObj(interp, objPtr); return JIM_ERR; } Jim_SetResultInt(interp, Jim_Length(objPtr)); @@ -149,6 +148,6 @@ static const jim_subcmd_type history_command_table[] = { int Jim_historyInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "history"); - Jim_CreateCommand(interp, "history", Jim_SubCmdProc, (void *)history_command_table, NULL); + Jim_RegisterSubCmd(interp, "history", history_command_table, NULL); return JIM_OK; } diff --git a/jim-interp.c b/jim-interp.c index 8868076..c545356 100644 --- a/jim-interp.c +++ b/jim-interp.c @@ -88,7 +88,7 @@ static int interp_cmd_alias(Jim_Interp *interp, int argc, Jim_Obj *const *argv) aliasPrefixList = Jim_NewListObj(interp, argv + 1, argc - 1); Jim_IncrRefCount(aliasPrefixList); - Jim_CreateCommand(child, Jim_String(argv[0]), JimInterpAliasProc, aliasPrefixList, JimInterpDelAlias); + Jim_RegisterCmd(child, Jim_String(argv[0]), NULL, 0, -1, JimInterpAliasProc, JimInterpDelAlias, aliasPrefixList, 0); return JIM_OK; } @@ -146,11 +146,6 @@ static int JimInterpCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) "argv", "argc", "argv0", "jim::argv0", "jim::exe", "jim::lineedit", NULL }; - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } - /* Create the interpreter command */ child = Jim_CreateInterp(); Jim_RegisterCoreCommands(child); @@ -165,7 +160,7 @@ static int JimInterpCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_SetAssocData(child, "interp.parent", NULL, interp); snprintf(buf, sizeof(buf), "interp.handle%ld", Jim_GetId(interp)); - Jim_CreateCommand(interp, buf, JimInterpSubCmdProc, child, JimInterpDelProc); + Jim_RegisterCmd(interp, buf, "subcommand ?arg ...?", 1, -1, JimInterpSubCmdProc, JimInterpDelProc, child, 0); Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); return JIM_OK; } @@ -173,7 +168,7 @@ static int JimInterpCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int Jim_interpInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "interp"); - Jim_CreateCommand(interp, "interp", JimInterpCommand, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "interp", "", 0, 0, JimInterpCommand); return JIM_OK; } @@ -38,6 +38,8 @@ typedef enum { } json_schema_t; struct json_state { + Jim_Obj *fileNameObj; + int line; Jim_Obj *nullObj; const char *json; jsmntok_t *tok; @@ -219,6 +221,7 @@ json_decode_dump_value(Jim_Interp *interp, struct json_state *state, Jim_Obj *li Jim_Obj *elem; int len = t->end - t->start; const char *p = state->json + t->start; + int set_source = 1; if (t->type == JSMN_STRING) { /* Do we need to process backslash escapes? */ if (state->need_subst == 0 && memchr(p, '\\', len) != NULL) { @@ -227,6 +230,7 @@ json_decode_dump_value(Jim_Interp *interp, struct json_state *state, Jim_Obj *li elem = Jim_NewStringObj(interp, p, len); } else if (p[0] == 'n') { /* null */ elem = state->nullObj; + set_source = 0; } else if (p[0] == 'I') { elem = Jim_NewStringObj(interp, "Inf", -1); } else if (p[0] == '-' && p[1] == 'I') { @@ -234,6 +238,10 @@ json_decode_dump_value(Jim_Interp *interp, struct json_state *state, Jim_Obj *li } else { /* number, true or false */ elem = Jim_NewStringObj(interp, p, len); } + if (set_source) { + /* Note we need to subtract 1 because both are 1-based values */ + Jim_SetSourceInfo(interp, elem, state->fileNameObj, state->line + t->line - 1); + } Jim_ListAppendElement(interp, list, elem); state->tok++; @@ -281,9 +289,7 @@ static int parse_json_decode_options(Jim_Interp *interp, int argc, Jim_Obj *cons } if (i != argc - 1) { - Jim_WrongNumArgs(interp, 1, argv, - "?-index? ?-null nullvalue? ?-schema? json"); - return JIM_ERR; + return JIM_USAGE; } return JIM_OK; @@ -361,7 +367,7 @@ json_decode(Jim_Interp *interp, int argc, Jim_Obj *const argv[]) state.nullObj = Jim_NewStringObj(interp, "null", -1); Jim_IncrRefCount(state.nullObj); - if (parse_json_decode_options(interp, argc, argv, &state) != JIM_OK) { + if ((ret = parse_json_decode_options(interp, argc, argv, &state)) != JIM_OK) { goto done; } @@ -371,6 +377,10 @@ json_decode(Jim_Interp *interp, int argc, Jim_Obj *const argv[]) Jim_SetResultString(interp, "empty JSON string", -1); goto done; } + + /* Save any source information from the original string */ + state.fileNameObj = Jim_GetSourceInfo(interp, argv[argc - 1], &state.line); + if ((tokens = json_decode_tokenize(interp, state.json, len)) == NULL) { goto done; } @@ -419,7 +429,7 @@ int Jim_jsonInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "json"); - Jim_CreateCommand(interp, "json::decode", json_decode, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "json::decode", "?-index? ?-null nullvalue? ?-schema? json", 1, 5, json_decode); /* Load the Tcl implementation of the json encoder if possible */ Jim_PackageRequire(interp, "jsonencode", 0); return JIM_OK; @@ -21,7 +21,20 @@ #define RTLD_LOCAL 0 #endif -static void JimFreeLoadHandles(Jim_Interp *interp, void *data); +static void JimFreeOneLoadHandle(void *handle) +{ + dlclose(handle); +} + +static void JimFreeLoadHandles(Jim_Interp *interp, void *data) +{ + Jim_Stack *handles = data; + + if (handles) { + Jim_StackFree(handles); + Jim_Free(handles); + } +} /** * Note that Jim_LoadLibrary() requires a path to an existing file. @@ -72,7 +85,7 @@ int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName) Jim_Stack *loadHandles = Jim_GetAssocData(interp, "load::handles"); if (loadHandles == NULL) { loadHandles = Jim_Alloc(sizeof(*loadHandles)); - Jim_InitStack(loadHandles); + Jim_StackInit(loadHandles, JimFreeOneLoadHandle); Jim_SetAssocData(interp, "load::handles", JimFreeLoadHandles, loadHandles); } Jim_StackPush(loadHandles, handle); @@ -88,22 +101,6 @@ int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName) return JIM_ERR; } -static void JimFreeOneLoadHandle(void *handle) -{ - dlclose(handle); -} - -static void JimFreeLoadHandles(Jim_Interp *interp, void *data) -{ - Jim_Stack *handles = data; - - if (handles) { - Jim_FreeStackElements(handles, JimFreeOneLoadHandle); - Jim_FreeStack(handles); - Jim_Free(handles); - } -} - #else /* JIM_DYNLIB */ int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName) { @@ -122,15 +119,11 @@ void Jim_FreeLoadHandles(Jim_Interp *interp) /* [load] */ static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "libraryFile"); - return JIM_ERR; - } return Jim_LoadLibrary(interp, Jim_String(argv[1])); } int Jim_loadInit(Jim_Interp *interp) { - Jim_CreateCommand(interp, "load", Jim_LoadCoreCommand, NULL, NULL); + Jim_RegisterCmd(interp, "load", "libraryFile", 1, 1, Jim_LoadCoreCommand, NULL, NULL, JIM_CMD_NOTAINT); return JIM_OK; } @@ -2258,14 +2258,13 @@ int Jim_mkInit(Jim_Interp *interp) { char version[MK_VERSION_SPACE]; + Jim_PackageProvideCheck(interp, "mk"); + snprintf(version, MK_VERSION_SPACE, "%d.%d.%d", d4_MetakitLibraryVersion / 100, d4_MetakitLibraryVersion % 100 / 10, d4_MetakitLibraryVersion % 10); - if (Jim_PackageProvide(interp, "mk", version, JIM_ERRMSG)) - return JIM_ERR; - Jim_CreateCommand(interp, "storage", JimStorageCommand, NULL, NULL); Jim_CreateCommand(interp, "cursor", JimCursorCommand, NULL, NULL); Jim_CreateCommand(interp, "mk.view.finalizer", JimViewFinalizerProc, NULL, NULL); diff --git a/jim-namespace.c b/jim-namespace.c index 0bdb0a9..c6e61b0 100644 --- a/jim-namespace.c +++ b/jim-namespace.c @@ -156,10 +156,6 @@ static int JimVariableCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { int retcode = JIM_OK; - if (argc > 3) { - Jim_WrongNumArgs(interp, 1, argv, "name ?value?"); - return JIM_ERR; - } if (argc > 1) { Jim_Obj *targetNameObj; Jim_Obj *localNameObj; @@ -231,7 +227,7 @@ static int JimNamespaceCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) JIM_DEF_SUBCMD("tail", "string", 1, 1), JIM_DEF_SUBCMD("upvar", "ns ?arg ...?", 1, -1), JIM_DEF_SUBCMD("which", "?-command|-variable? name", 1, 2), - { /* null terminator */ } + { NULL } }; const jim_subcmd_type *ct = Jim_ParseSubCmd(interp, namespace_cmds, argc, argv); if (ct) { @@ -334,8 +330,7 @@ static int JimNamespaceCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int Jim_namespaceInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "namespace"); - Jim_CreateCommand(interp, "namespace", JimNamespaceCmd, NULL, NULL); - Jim_CreateCommand(interp, "variable", JimVariableCmd, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "namespace", "subcommand ?arg ...?", 1, -1, JimNamespaceCmd); + Jim_RegisterSimpleCmd(interp, "variable", "name ?value?", 1, 2, JimVariableCmd); return JIM_OK; } - @@ -281,11 +281,6 @@ static int Jim_UnpackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) jim_wide pos; jim_wide width; - if (argc != 5) { - Jim_WrongNumArgs(interp, 1, argv, - "binvalue -intbe|-intle|-uintbe|-uintle|-floatbe|-floatle|-str bitpos bitwidth"); - return JIM_ERR; - } if (Jim_GetEnum(interp, argv[2], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { return JIM_ERR; } @@ -376,13 +371,7 @@ static int Jim_PackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) double fvalue; Jim_Obj *stringObjPtr; int len; - int freeobj = 0; - if (argc != 5 && argc != 6) { - Jim_WrongNumArgs(interp, 1, argv, - "varName value -intle|-intbe|-floatle|-floatbe|-str bitwidth ?bitoffset?"); - return JIM_ERR; - } if (Jim_GetEnum(interp, argv[3], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { return JIM_ERR; } @@ -416,10 +405,8 @@ static int Jim_PackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) if (!stringObjPtr) { /* Create the string if it doesn't exist */ stringObjPtr = Jim_NewEmptyStringObj(interp); - freeobj = 1; } else if (Jim_IsShared(stringObjPtr)) { - freeobj = 1; stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr); } @@ -465,10 +452,7 @@ static int Jim_PackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) } if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) { - if (freeobj) { - Jim_FreeNewObj(interp, stringObjPtr); - return JIM_ERR; - } + return JIM_ERR; } return JIM_OK; } @@ -476,7 +460,7 @@ static int Jim_PackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int Jim_packInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "pack"); - Jim_CreateCommand(interp, "unpack", Jim_UnpackCmd, NULL, NULL); - Jim_CreateCommand(interp, "pack", Jim_PackCmd, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "pack", "varName value -intle|-intbe|-floatle|-floatbe|-str bitwidth ?bitoffset?", 4, 5, Jim_PackCmd); + Jim_RegisterSimpleCmd(interp, "unpack", "binvalue -intbe|-intle|-uintbe|-uintle|-floatbe|-floatle|-str bitpos bitwidth", 4, 4, Jim_UnpackCmd); return JIM_OK; } diff --git a/jim-package.c b/jim-package.c index 69af074..925b9b9 100644 --- a/jim-package.c +++ b/jim-package.c @@ -47,7 +47,13 @@ static char *JimFindPackage(Jim_Interp *interp, Jim_Obj *prefixListObj, const ch for (i = 0; i < prefixc; i++) { Jim_Obj *prefixObjPtr = Jim_ListGetIndex(interp, prefixListObj, i); - const char *prefix = Jim_String(prefixObjPtr); + const char *prefix; + + if (Jim_GetObjTaint(prefixObjPtr)) { + /* This element is tainted, so ignore it */ + continue; + } + prefix = Jim_String(prefixObjPtr); /* Loadable modules are tried first */ #ifdef jim_ext_load @@ -111,10 +117,8 @@ static int JimLoadPackage(Jim_Interp *interp, const char *name, int flags) } Jim_Free(path); } - - return retCode; } - return JIM_ERR; + return retCode; } int Jim_PackageRequire(Jim_Interp *interp, const char *name, int flags) @@ -148,6 +152,16 @@ int Jim_PackageRequire(Jim_Interp *interp, const char *name, int flags) return JIM_OK; } +static int package_cmd_forget(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + + for (i = 0; i < argc; i++) { + Jim_DeleteHashEntry(&interp->packages, Jim_String(argv[i])); + } + return JIM_OK; +} + /* *---------------------------------------------------------------------- * @@ -216,6 +230,14 @@ static int package_cmd_names(Jim_Interp *interp, int argc, Jim_Obj *const *argv) static const jim_subcmd_type package_command_table[] = { { + "forget", + "package ...", + package_cmd_forget, + 1, + -1, + /* Description: Forget that the given packages were loaded */ + }, + { "provide", "name ?version?", package_cmd_provide, @@ -255,6 +277,6 @@ static const jim_subcmd_type package_command_table[] = { int Jim_packageInit(Jim_Interp *interp) { - Jim_CreateCommand(interp, "package", Jim_SubCmdProc, (void *)package_command_table, NULL); + Jim_RegisterSubCmd(interp, "package", package_command_table, NULL); return JIM_OK; } diff --git a/jim-posix.c b/jim-posix.c index 5a6fb98..c308540 100644 --- a/jim-posix.c +++ b/jim-posix.c @@ -45,6 +45,9 @@ #ifdef HAVE_SYS_SYSINFO_H #include <sys/sysinfo.h> #endif +#ifdef HAVE_SYS_STAT_H +#include <sys/stat.h> +#endif static void Jim_PosixSetError(Jim_Interp *interp) { @@ -58,10 +61,6 @@ static int Jim_PosixForkCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar JIM_NOTUSED(argv); - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } if ((pid = fork()) == -1) { Jim_PosixSetError(interp); return JIM_ERR; @@ -76,10 +75,6 @@ static int Jim_PosixGetidsCommand(Jim_Interp *interp, int argc, Jim_Obj *const * { Jim_Obj *objv[8]; - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } objv[0] = Jim_NewStringObj(interp, "uid", -1); objv[1] = Jim_NewIntObj(interp, getuid()); objv[2] = Jim_NewStringObj(interp, "euid", -1); @@ -98,10 +93,6 @@ static int Jim_PosixGethostnameCommand(Jim_Interp *interp, int argc, Jim_Obj *co char *buf; int rc = JIM_OK; - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } buf = Jim_Alloc(JIM_HOST_NAME_MAX); if (gethostname(buf, JIM_HOST_NAME_MAX) == -1) { Jim_PosixSetError(interp); @@ -119,11 +110,6 @@ static int Jim_PosixUptimeCommand(Jim_Interp *interp, int argc, Jim_Obj *const * #ifdef HAVE_STRUCT_SYSINFO_UPTIME struct sysinfo info; - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } - if (sysinfo(&info) == -1) { Jim_PosixSetError(interp); return JIM_ERR; @@ -135,18 +121,38 @@ static int Jim_PosixUptimeCommand(Jim_Interp *interp, int argc, Jim_Obj *const * #endif return JIM_OK; } + +static int Jim_PosixUmaskCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + mode_t oldmask; + + if (argc == 2) { + long mask; + if (Jim_GetLong(interp, argv[1], &mask) != JIM_OK) { + return JIM_ERR; + } + oldmask = umask(mask); + } + else { + oldmask = umask(0); + umask(oldmask); + } + Jim_SetResultInt(interp, oldmask); + return JIM_OK; +} #endif /* JIM_BOOTSTRAP */ int Jim_posixInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "posix"); #ifdef HAVE_FORK - Jim_CreateCommand(interp, "os.fork", Jim_PosixForkCommand, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "os.fork", "", 0, 0, Jim_PosixForkCommand); #endif #if !defined(JIM_BOOTSTRAP) - Jim_CreateCommand(interp, "os.getids", Jim_PosixGetidsCommand, NULL, NULL); - Jim_CreateCommand(interp, "os.gethostname", Jim_PosixGethostnameCommand, NULL, NULL); - Jim_CreateCommand(interp, "os.uptime", Jim_PosixUptimeCommand, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "os.gethostname", "", 0, 0, Jim_PosixGethostnameCommand); + Jim_RegisterSimpleCmd(interp, "os.getids", "", 0, 0, Jim_PosixGetidsCommand); + Jim_RegisterSimpleCmd(interp, "os.uptime", "", 0, 0, Jim_PosixUptimeCommand); + Jim_RegisterSimpleCmd(interp, "os.umask", "?newmask?", 0, 1, Jim_PosixUmaskCommand); #endif /* JIM_BOOTSTRAP */ return JIM_OK; } diff --git a/jim-readdir.c b/jim-readdir.c index 07c558e..3823fb7 100644 --- a/jim-readdir.c +++ b/jim-readdir.c @@ -77,8 +77,7 @@ int Jim_ReaddirCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) nocomplain = 1; } if (argc != 2 && !nocomplain) { - Jim_WrongNumArgs(interp, 1, argv, "?-nocomplain? dirPath"); - return JIM_ERR; + return JIM_USAGE; } dirPath = Jim_String(argv[1 + nocomplain]); @@ -115,6 +114,6 @@ int Jim_ReaddirCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int Jim_readdirInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "readdir"); - Jim_CreateCommand(interp, "readdir", Jim_ReaddirCmd, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "readdir", "?-nocomplain? dirPath", 1, 2, Jim_ReaddirCmd); return JIM_OK; } diff --git a/jim-readline.c b/jim-readline.c index 5715b2c..9acef8d 100644 --- a/jim-readline.c +++ b/jim-readline.c @@ -34,6 +34,8 @@ #include <jim.h> +#include <stdio.h> + #include <readline/readline.h> #include <readline/history.h> @@ -41,10 +43,6 @@ static int JimRlReadlineCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar { char *line; - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "prompt"); - return JIM_ERR; - } line = readline(Jim_String(argv[1])); if (!line) { return JIM_EXIT; @@ -55,10 +53,6 @@ static int JimRlReadlineCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar static int JimRlAddHistoryCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "string"); - return JIM_ERR; - } add_history(Jim_String(argv[1])); return JIM_OK; } @@ -66,7 +60,7 @@ static int JimRlAddHistoryCommand(Jim_Interp *interp, int argc, Jim_Obj *const * int Jim_readlineInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "readline"); - Jim_CreateCommand(interp, "readline.readline", JimRlReadlineCommand, NULL, NULL); - Jim_CreateCommand(interp, "readline.addhistory", JimRlAddHistoryCommand, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "readline.readline", "prompt", 1, 1, JimRlReadlineCommand); + Jim_RegisterSimpleCmd(interp, "readline.addhistory", "string", 1, 1, JimRlAddHistoryCommand); return JIM_OK; } diff --git a/jim-redis.c b/jim-redis.c index d7e5770..6628aa5 100644 --- a/jim-redis.c +++ b/jim-redis.c @@ -135,6 +135,10 @@ static int jim_redis_subcmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) reply = NULL; } } + else if (Jim_GetObjTaint(argv[1]) & JIM_TAINT_ANY) { + Jim_SetTaintError(interp, 1, argv); + return JIM_ERR; + } else { int nargs = argc - 1; args = Jim_Alloc(sizeof(*args) * nargs); @@ -197,8 +201,7 @@ static int jim_redis_cmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) async = 1; } if (argc - async != 2) { - Jim_WrongNumArgs(interp, 1, argv, "?-async? socket-stream"); - return JIM_ERR; + return JIM_USAGE; } /* Invoke getfd to get the file descriptor */ @@ -209,7 +212,7 @@ static int jim_redis_cmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) 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]); + Jim_SetResultFormatted(interp, "%#s: not a valid stream handle: %#s", argv[0], argv[1 + async]); return ret; } @@ -225,7 +228,7 @@ static int jim_redis_cmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) /* Now delete the original stream */ Jim_DeleteCommand(interp, argv[1 + async]); snprintf(buf, sizeof(buf), "redis.handle%ld", Jim_GetId(interp)); - Jim_CreateCommand(interp, buf, jim_redis_subcmd, c, jim_redis_del_proc); + Jim_RegisterCmd(interp, buf, "subcommand ?arg ...?", 1, -1, jim_redis_subcmd, jim_redis_del_proc, c, 0); Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); @@ -236,6 +239,6 @@ int Jim_redisInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "redis"); - Jim_CreateCommand(interp, "redis", jim_redis_cmd, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "redis", "?-async? socket-stream", 1, 2, jim_redis_cmd); return JIM_OK; } diff --git a/jim-regexp.c b/jim-regexp.c index f370e5e..554e883 100644 --- a/jim-regexp.c +++ b/jim-regexp.c @@ -122,6 +122,7 @@ int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int opt_indices = 0; int opt_all = 0; int opt_inline = 0; + int opt_lineanchor = 0; regex_t *regex; int match, i, j; int offset = 0; @@ -137,26 +138,19 @@ int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int eflags = 0; int option; enum { - OPT_INDICES, OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_INLINE, OPT_START, OPT_END + OPT_INDICES, OPT_NOCASE, OPT_LINE, OPT_LINESTOP, OPT_LINEANCHOR, OPT_ALL, OPT_INLINE, OPT_START, OPT_EXPANDED, OPT_END }; static const char * const options[] = { - "-indices", "-nocase", "-line", "-all", "-inline", "-start", "--", NULL + "-indices", "-nocase", "-line", "-linestop", "-lineanchor", "-all", "-inline", "-start", "-expanded", "--", 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) { + if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { return JIM_ERR; } if (option == OPT_END) { @@ -174,8 +168,20 @@ int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) case OPT_LINE: regcomp_flags |= REG_NEWLINE; + opt_lineanchor = 1; break; +#ifdef REG_NEWLINE_STOP + case OPT_LINESTOP: + regcomp_flags |= REG_NEWLINE_STOP; + break; +#endif +#ifdef REG_NEWLINE_ANCHOR + case OPT_LINEANCHOR: + regcomp_flags |= REG_NEWLINE_ANCHOR; + opt_lineanchor = 1; + break; +#endif case OPT_ALL: opt_all = 1; break; @@ -186,16 +192,26 @@ int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) case OPT_START: if (++i == argc) { - goto wrongNumArgs; + return JIM_USAGE; } if (Jim_GetIndex(interp, argv[i], &offset) != JIM_OK) { return JIM_ERR; } break; + +#ifdef REG_EXPANDED + case OPT_EXPANDED: + regcomp_flags |= REG_EXPANDED; + break; +#endif + default: + /* Could get here if -linestop or -lineanchor or -expanded is not supported */ + Jim_SetResultFormatted(interp, "not supported: %#s", argv[i]); + return JIM_ERR; } } if (argc - i < 2) { - goto wrongNumArgs; + return JIM_USAGE; } regex = SetRegexpFromAny(interp, argv[i], regcomp_flags); @@ -257,10 +273,11 @@ int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) num_matches++; - if (opt_all && !opt_inline) { - /* Just count the number of matches, so skip the substitution h */ - goto try_next_match; - } + /* We used to not assign vars for -all if not -inline, since we can't + * really assign capture groups for multiple matches, but Tcl does this, + * just setting the last value for each capture group, so we will do the + * same for compatibility + */ /* * If additional variable names have been specified, return @@ -268,7 +285,7 @@ int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) */ j = 0; - for (i += 2; opt_inline ? j < num_vars : i < argc; i++, j++) { + for (j = 0; j < num_vars; j++) { Jim_Obj *resultObj; if (opt_indices) { @@ -302,17 +319,15 @@ int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) } else { /* And now set the result variable */ - result = Jim_SetVariable(interp, argv[i], resultObj); + result = Jim_SetVariable(interp, argv[i + 2 + j], 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 (opt_all && (pattern[0] != '^' || opt_lineanchor) && *source_str) { if (pmatch[0].rm_eo) { offset += utf8_strlen(source_str, pmatch[0].rm_eo); source_str += pmatch[0].rm_eo; @@ -368,26 +383,19 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) const char *pattern; int option; enum { - OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_START, OPT_COMMAND, OPT_END + OPT_NOCASE, OPT_LINE, OPT_LINESTOP, OPT_LINEANCHOR, OPT_ALL, OPT_START, OPT_COMMAND, OPT_EXPANDED, OPT_END }; static const char * const options[] = { - "-nocase", "-line", "-all", "-start", "-command", "--", NULL + "-nocase", "-line", "-linestop", "-lineanchor", "-all", "-start", "-command", "-expanded", "--", 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) { + if (Jim_GetEnum(interp, argv[i], options, &option, "option", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { return JIM_ERR; } if (option == OPT_END) { @@ -403,13 +411,23 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) regcomp_flags |= REG_NEWLINE; break; +#ifdef REG_NEWLINE_STOP + case OPT_LINESTOP: + regcomp_flags |= REG_NEWLINE_STOP; + break; +#endif +#ifdef REG_NEWLINE_ANCHOR + case OPT_LINEANCHOR: + regcomp_flags |= REG_NEWLINE_ANCHOR; + break; +#endif case OPT_ALL: opt_all = 1; break; case OPT_START: if (++i == argc) { - goto wrongNumArgs; + return JIM_USAGE; } if (Jim_GetIndex(interp, argv[i], &offset) != JIM_OK) { return JIM_ERR; @@ -419,18 +437,29 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) case OPT_COMMAND: opt_command = 1; break; + +#ifdef REG_EXPANDED + case OPT_EXPANDED: + regcomp_flags |= REG_EXPANDED; + break; +#endif + + default: + /* Could get here if -linestop or -lineanchor or -expanded is not supported */ + Jim_SetResultFormatted(interp, "not supported: %#s", argv[i]); + return JIM_ERR; } } if (argc - i != 3 && argc - i != 4) { - goto wrongNumArgs; + return JIM_USAGE; } - /* Need to ensure that this is unshared, so just duplicate it always */ + /* Need to ensure that this is unshared, so just duplicate it always */ regcomp_obj = Jim_DuplicateObj(interp, argv[i]); - Jim_IncrRefCount(regcomp_obj); + Jim_IncrRefCount(regcomp_obj); regex = SetRegexpFromAny(interp, regcomp_obj, regcomp_flags); if (!regex) { - Jim_DecrRefCount(interp, regcomp_obj); + Jim_DecrRefCount(interp, regcomp_obj); return JIM_ERR; } pattern = Jim_String(argv[i]); @@ -440,7 +469,7 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) cmd_prefix = argv[i + 2]; if (Jim_ListLength(interp, cmd_prefix) == 0) { Jim_SetResultString(interp, "command prefix must be a list of at least one element", -1); - Jim_DecrRefCount(interp, regcomp_obj); + Jim_DecrRefCount(interp, regcomp_obj); return JIM_ERR; } Jim_IncrRefCount(cmd_prefix); @@ -482,7 +511,11 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) n = source_len - offset; p = source_str + offset; - do { + + /* To match Tcl, an empty pattern does not match at the end + * of the string. + */ + while (n || pattern[0]) { int match = jim_regexec(regex, p, MAX_SUB_MATCHES, pmatch, regexec_flags); if (match >= REG_BADPAT) { @@ -576,28 +609,22 @@ int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) break; } - /* An anchored pattern without -line must be done */ - if ((regcomp_flags & REG_NEWLINE) == 0 && pattern[0] == '^') { - break; - } - - /* If the pattern is empty, need to step forwards */ - if (pattern[0] == '\0' && n) { - /* Need to copy the char we are moving over */ - Jim_AppendString(interp, resultObj, p, 1); - p++; - n--; - } - + regexec_flags = 0; 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; + /* Matched a zero length string. Need to avoid matching the same position again */ + if (pattern[0] == '^') { + /* An anchored search sets REG_BOL */ + regexec_flags = REG_NOTBOL; + } + else { + /* A non-anchored search advances by one char */ + int charlen = utf8_charlen(p[0]); + Jim_AppendString(interp, resultObj, p, charlen); + p += charlen; + n -= charlen; + } } - - } while (n); + } /* * Copy the portion of the string after the last match to the @@ -614,9 +641,6 @@ cmd_error: if (result == JIM_OK) { Jim_SetResultInt(interp, num_matches); } - else { - Jim_FreeObj(interp, resultObj); - } } else { Jim_SetResult(interp, resultObj); @@ -631,7 +655,7 @@ cmd_error: Jim_DecrRefCount(interp, cmd_prefix); } - Jim_DecrRefCount(interp, regcomp_obj); + Jim_DecrRefCount(interp, regcomp_obj); return result; } @@ -639,7 +663,7 @@ cmd_error: int Jim_regexpInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "regexp"); - Jim_CreateCommand(interp, "regexp", Jim_RegexpCmd, NULL, NULL); - Jim_CreateCommand(interp, "regsub", Jim_RegsubCmd, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "regexp", "?-option ...? exp string ?matchVar? ?subMatchVar ...?", 2, -1, Jim_RegexpCmd); + Jim_RegisterSimpleCmd(interp, "regsub", "?-option ...? exp string subSpec ?varName?", 3, -1, Jim_RegsubCmd); return JIM_OK; } @@ -471,11 +471,6 @@ static int JimSdlSurfaceCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar long vals[2]; const char *title; - if (argc != 3 && argc != 4) { - Jim_WrongNumArgs(interp, 1, argv, "xres yres ?title?"); - return JIM_ERR; - } - if (JimSdlGetLongs(interp, 2, argv + 1, vals) != JIM_OK) { return JIM_ERR; } @@ -536,6 +531,6 @@ static int JimSdlSurfaceCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar int Jim_sdlInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "sdl"); - Jim_CreateCommand(interp, "sdl.screen", JimSdlSurfaceCommand, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "sdl.screen", "xres yres ?title?", 2, 3, JimSdlSurfaceCommand); return JIM_OK; } diff --git a/jim-signal.c b/jim-signal.c index 328a139..88862da 100644 --- a/jim-signal.c +++ b/jim-signal.c @@ -440,11 +440,7 @@ static int Jim_AlarmCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { int ret; - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "seconds"); - return JIM_ERR; - } - else { + { #ifdef HAVE_UALARM double t; @@ -473,21 +469,14 @@ static int Jim_AlarmCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) static int Jim_SleepCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { int ret; + double t; - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "seconds"); - return JIM_ERR; - } - else { - double t; - - ret = Jim_GetDouble(interp, argv[1], &t); - if (ret == JIM_OK) { + ret = Jim_GetDouble(interp, argv[1], &t); + if (ret == JIM_OK) { #ifdef HAVE_USLEEP - usleep((int)((t - (int)t) * 1e6)); + usleep((int)((t - (int)t) * 1e6)); #endif - sleep(t); - } + sleep(t); } return ret; @@ -500,11 +489,6 @@ static int Jim_KillCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) Jim_Obj *pidObj; const char *signame; - if (argc != 2 && argc != 3) { - Jim_WrongNumArgs(interp, 1, argv, "?SIG|-0? pid"); - return JIM_ERR; - } - if (argc == 2) { sig = SIGTERM; pidObj = argv[1]; @@ -540,10 +524,10 @@ static int Jim_KillCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int Jim_signalInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "signal"); - Jim_CreateCommand(interp, "alarm", Jim_AlarmCmd, 0, 0); - Jim_CreateCommand(interp, "kill", Jim_KillCmd, 0, 0); + Jim_RegisterSimpleCmd(interp, "alarm", "seconds", 1, 1, Jim_AlarmCmd); + Jim_RegisterSimpleCmd(interp, "kill", "?SIG|-0? pid", 1, 2, Jim_KillCmd); /* Sleep is slightly dubious here */ - Jim_CreateCommand(interp, "sleep", Jim_SleepCmd, 0, 0); + Jim_RegisterSimpleCmd(interp, "sleep", "seconds", 1, 1, Jim_SleepCmd); /* Teach the jim core how to set a result from a sigmask */ interp->signal_set_result = signal_set_sigmask_result; @@ -554,8 +538,7 @@ int Jim_signalInit(Jim_Interp *interp) /* Make sure we know where to store the signals which occur */ sigloc = &interp->sigmask; - - Jim_CreateCommand(interp, "signal", Jim_SubCmdProc, (void *)signal_command_table, JimSignalCmdDelete); + Jim_RegisterSubCmd(interp, "signal", signal_command_table, JimSignalCmdDelete); } return JIM_OK; diff --git a/jim-sqlite3.c b/jim-sqlite3.c index 61d4c52..0633ec9 100644 --- a/jim-sqlite3.c +++ b/jim-sqlite3.c @@ -75,6 +75,11 @@ static Jim_Obj *JimSqliteFormatQuery(Jim_Interp *interp, Jim_Obj *fmtObjPtr, int fmtLen; Jim_Obj *resObjPtr; + if (Jim_GetObjTaint(fmtObjPtr) & JIM_TAINT_ANY) { + Jim_SetResultString(interp, "sqlite3 query: tainted data", -1); + return NULL; + } + fmt = Jim_GetString(fmtObjPtr, &fmtLen); resObjPtr = Jim_NewStringObj(interp, "", 0); while (fmtLen) { @@ -143,10 +148,6 @@ static int JimSqliteHandlerCommand(Jim_Interp *interp, int argc, Jim_Obj *const enum { OPT_CLOSE, OPT_QUERY, OPT_LASTID, OPT_CHANGES }; - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "method ?args ...?"); - return JIM_ERR; - } if (Jim_GetEnum(interp, argv[1], options, &option, "Sqlite method", JIM_ERRMSG) != JIM_OK) return JIM_ERR; /* CLOSE */ @@ -265,10 +266,6 @@ static int JimSqliteOpenCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar char buf[60]; int r; - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "dbname"); - return JIM_ERR; - } r = sqlite3_open(Jim_String(argv[1]), &db); if (r != SQLITE_OK) { Jim_SetResultString(interp, sqlite3_errmsg(db), -1); @@ -277,7 +274,7 @@ static int JimSqliteOpenCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar } /* Create the file command */ snprintf(buf, sizeof(buf), "sqlite.handle%ld", Jim_GetId(interp)); - Jim_CreateCommand(interp, buf, JimSqliteHandlerCommand, db, JimSqliteDelProc); + Jim_RegisterCmd(interp, buf, "subcommand ?arg ...?", 1, -1, JimSqliteHandlerCommand, JimSqliteDelProc, db, 0); Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); @@ -287,6 +284,6 @@ static int JimSqliteOpenCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar int Jim_sqlite3Init(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "sqlite3"); - Jim_CreateCommand(interp, "sqlite3.open", JimSqliteOpenCommand, NULL, NULL); + Jim_RegisterCmd(interp, "sqlite3.open", "dbname", 1, 1, JimSqliteOpenCommand, NULL, NULL, JIM_CMD_NOTAINT); return JIM_OK; } diff --git a/jim-subcmd.c b/jim-subcmd.c index 8a946ce..75a9168 100644 --- a/jim-subcmd.c +++ b/jim-subcmd.c @@ -230,14 +230,22 @@ int Jim_CallSubCmd(Jim_Interp *interp, const jim_subcmd_type * ct, int argc, Jim int ret = JIM_ERR; if (ct) { - if (ct->flags & JIM_MODFLAG_FULLARGV) { + if ((ct->flags & JIM_MODFLAG_NOTAINT) && Jim_CheckTaint(interp, JIM_TAINT_ANY)) { + ret = JIM_SUBCMD_TAINTED; + } + else if (ct->flags & JIM_MODFLAG_FULLARGV) { ret = ct->function(interp, argc, argv); } else { ret = ct->function(interp, argc - 2, argv + 2); } if (ret < 0) { - Jim_SubCmdArgError(interp, ct, argv[0]); + if (ret == JIM_SUBCMD_TAINTED) { + Jim_SetTaintError(interp, 2, argv); + } + else { + Jim_SubCmdArgError(interp, ct, argv[0]); + } ret = JIM_ERR; } } @@ -251,3 +259,15 @@ int Jim_SubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return Jim_CallSubCmd(interp, ct, argc, argv); } + +Jim_Cmd *Jim_RegisterSubCmd(Jim_Interp *interp, const char *cmdname, + const jim_subcmd_type *command_table, Jim_DelCmdProc *delProc) +{ + return Jim_RegisterCmd(interp, cmdname, + "subcommand ?arg ...?", + 1, -1, + Jim_SubCmdProc, + delProc, + (void *)command_table, + 0); +} diff --git a/jim-subcmd.h b/jim-subcmd.h index a2fe548..4b39b17 100644 --- a/jim-subcmd.h +++ b/jim-subcmd.h @@ -13,6 +13,10 @@ extern "C" { #define JIM_MODFLAG_HIDDEN 0x0001 /* Don't show the subcommand in usage or commands */ #define JIM_MODFLAG_FULLARGV 0x0002 /* Subcmd proc gets called with full argv */ +#define JIM_MODFLAG_NOTAINT 0x0004 /* May not be called with tainted data */ + +#define JIM_SUBCMD_BADARGS -1 +#define JIM_SUBCMD_TAINTED -2 /* Custom flags start at 0x0100 */ @@ -58,9 +62,9 @@ Jim_ParseSubCmd(Jim_Interp *interp, const jim_subcmd_type *command_table, int ar * Parses the args against the given command table and executes the subcommand if found * or sets an appropriate error if the subcommand or arguments is invalid. * - * Can be used directly with Jim_CreateCommand() where the ClientData is the command table. + * Typically used via Jim_RegisterCmd() * - * e.g. Jim_CreateCommand(interp, "mycmd", Jim_SubCmdProc, command_table, NULL); + * e.g. Jim_RegisterSubCmd(interp, "mycmd", command_table, NULL); */ int Jim_SubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv); @@ -83,6 +87,12 @@ int Jim_CallSubCmd(Jim_Interp *interp, const jim_subcmd_type *ct, int argc, Jim_ */ void Jim_SubCmdArgError(Jim_Interp *interp, const jim_subcmd_type *ct, Jim_Obj *subcmd); +/** + * Convenience wrapper around Jim_RegisterCmd() to register a subcmd command. + */ +Jim_Cmd *Jim_RegisterSubCmd(Jim_Interp *interp, const char *cmdname, + const jim_subcmd_type *command_table, Jim_DelCmdProc *delProc); + #ifdef __cplusplus } #endif diff --git a/jim-syslog.c b/jim-syslog.c index ad8af59..42c9992 100644 --- a/jim-syslog.c +++ b/jim-syslog.c @@ -79,12 +79,6 @@ int Jim_SyslogCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) int i = 1; SyslogInfo *info = Jim_CmdPrivData(interp); - if (argc <= 1) { - wrongargs: - Jim_WrongNumArgs(interp, 1, argv, - "?-facility cron|daemon|...? ?-ident string? ?-options int? ?debug|info|...? message"); - return JIM_ERR; - } while (i < argc - 1) { if (Jim_CompareStringImmediate(interp, argv[i], "-facility")) { int entry = @@ -146,7 +140,7 @@ int Jim_SyslogCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) } if (i != argc - 1) { - goto wrongargs; + return JIM_USAGE; } if (!info->logOpened) { if (!info->ident[0]) { @@ -181,7 +175,8 @@ int Jim_syslogInit(Jim_Interp *interp) info->facility = LOG_USER; info->ident[0] = 0; - Jim_CreateCommand(interp, "syslog", Jim_SyslogCmd, info, Jim_SyslogCmdDelete); + Jim_RegisterCmd(interp, "syslog", "?-facility cron|daemon|...? ?-ident string? ?-options int? ?debug|info|...? message", + 1, -1, Jim_SyslogCmd, Jim_SyslogCmdDelete, info, 0); return JIM_OK; } diff --git a/jim-tclprefix.c b/jim-tclprefix.c index c451119..22c6904 100644 --- a/jim-tclprefix.c +++ b/jim-tclprefix.c @@ -64,10 +64,6 @@ static int Jim_TclPrefixCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const static const char * const options[] = { "match", "all", "longest", NULL }; enum { OPT_MATCH, OPT_ALL, OPT_LONGEST }; - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arg ...?"); - 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); @@ -215,6 +211,6 @@ static int Jim_TclPrefixCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const int Jim_tclprefixInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "tclprefix"); - Jim_CreateCommand(interp, "tcl::prefix", Jim_TclPrefixCoreCommand, NULL, NULL); + Jim_RegisterSimpleCmd(interp, "tcl::prefix", "subcommand ?arg ...?", 1, -1, Jim_TclPrefixCoreCommand); return JIM_OK; } diff --git a/jim-win32.c b/jim-win32.c index 858e49d..cbc3bae 100644 --- a/jim-win32.c +++ b/jim-win32.c @@ -100,6 +100,10 @@ Win32_ShellExecute(Jim_Interp *interp, int objc, Jim_Obj * const *objv) Jim_WrongNumArgs(interp, 1, objv, "verb path ?parameters?"); return JIM_ERR; } + if (Jim_CheckTaint(interp, JIM_TAINT_ANY)) { + Jim_SetTaintError(interp, 1, objv); + return JIM_ERR; + } verb = Jim_String(objv[1]); file = Jim_String(objv[2]); GetCurrentDirectoryA(MAX_PATH + 1, cwd); diff --git a/jim-win32compat.h b/jim-win32compat.h index 16133b5..acb47c8 100644 --- a/jim-win32compat.h +++ b/jim-win32compat.h @@ -30,6 +30,9 @@ char *dlerror(void); #include <limits.h> #define jim_wide _int64 +#ifndef HAVE_LONG_LONG +#define HAVE_LONG_LONG +#endif #ifndef LLONG_MAX #define LLONG_MAX 9223372036854775807I64 #endif @@ -43,12 +46,8 @@ char *dlerror(void); #define strtoull _strtoui64 #include <io.h> - -struct timeval { - long tv_sec; - long tv_usec; -}; - +/* For struct timeval */ +#include <winsock.h> int gettimeofday(struct timeval *tv, void *unused); #define HAVE_OPENDIR @@ -302,15 +302,10 @@ static const jim_subcmd_type zlib_command_table[] = { { NULL } }; -static int JimZlibCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) -{ - return Jim_CallSubCmd(interp, Jim_ParseSubCmd(interp, zlib_command_table, argc, argv), argc, argv); -} - int Jim_zlibInit(Jim_Interp *interp) { Jim_PackageProvideCheck(interp, "zlib"); - Jim_CreateCommand(interp, "zlib", JimZlibCmd, 0, 0); + Jim_RegisterSubCmd(interp, "zlib", zlib_command_table, NULL); return JIM_OK; } @@ -109,7 +109,8 @@ /* Maximum size of an integer */ #define JIM_INTEGER_SPACE 24 -#if defined(DEBUG_SHOW_SCRIPT) || defined(DEBUG_SHOW_SCRIPT_TOKENS) || defined(JIM_DEBUG_COMMAND) || defined(DEBUG_SHOW_SUBST) +#if defined(DEBUG_SHOW_SCRIPT) || defined(DEBUG_SHOW_SCRIPT_TOKENS) || defined(JIM_DEBUG_COMMAND) || defined(DEBUG_SHOW_EXPR_TOKENS) || defined(DEBUG_SHOW_EXPR) +#define JIM_TT_NAME static const char *jim_tt_name(int type); #endif @@ -156,6 +157,7 @@ static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len); static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_VarVal *vv); static Jim_VarVal *JimFindVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr); static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); +static int JimCallNative(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv); #define JIM_DICT_SUGAR 100 /* Only returned by SetVariableFromAny() */ @@ -1167,21 +1169,24 @@ static const Jim_HashTableType JimAssocDataHashTableType = { * Stack - This is a simple generic stack implementation. It is used for * example in the 'expr' expression compiler. * ---------------------------------------------------------------------------*/ -void Jim_InitStack(Jim_Stack *stack) +void Jim_StackInit(Jim_Stack *stack, void (*freefunc) (void *ptr)) { stack->len = 0; stack->maxlen = 0; stack->vector = NULL; + stack->freefunc = freefunc; } -void Jim_FreeStack(Jim_Stack *stack) +void Jim_StackFree(Jim_Stack *stack) { - Jim_Free(stack->vector); -} + int i; -int Jim_StackLen(Jim_Stack *stack) -{ - return stack->len; + if (stack->freefunc) { + for (i = 0; i < stack->len; i++) { + stack->freefunc(stack->vector[i]); + } + } + Jim_Free(stack->vector); } void Jim_StackPush(Jim_Stack *stack, void *element) @@ -1204,21 +1209,6 @@ void *Jim_StackPop(Jim_Stack *stack) 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]); -} - /* ----------------------------------------------------------------------------- * Tcl Parser * ---------------------------------------------------------------------------*/ @@ -2239,6 +2229,7 @@ Jim_Obj *Jim_NewObj(Jim_Interp *interp) * kind of GC implemented should take care to avoid * scanning objects with refCount == 0. */ objPtr->refCount = 0; + objPtr->taint = interp->taint; /* All the other fields are left uninitialized to save time. * The caller will probably want to set them to the right * value anyway. */ @@ -2305,6 +2296,8 @@ Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr) Jim_Obj *dupPtr; dupPtr = Jim_NewObj(interp); + dupPtr->taint = objPtr->taint; + if (objPtr->bytes == NULL) { /* Object does not have a valid string representation. */ dupPtr->bytes = NULL; @@ -2585,6 +2578,7 @@ 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); + objPtr->taint |= appendObjPtr->taint; } void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...) @@ -2613,7 +2607,7 @@ int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr) const char *sA = Jim_GetString(aObjPtr, &Alen); const char *sB = Jim_GetString(bObjPtr, &Blen); - return Alen == Blen && memcmp(sA, sB, Alen) == 0; + return Alen == Blen && *sA == *sB && memcmp(sA, sB, Alen) == 0; } } @@ -3148,11 +3142,21 @@ int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char * } } +/* Note that we explicitly sort -- after other options */ static int qsortCompareStringPointers(const void *a, const void *b) { char *const *sa = (char *const *)a; char *const *sb = (char *const *)b; + /* Always sort "--" to the end to match Tcl 9.0 */ + if (strcmp(*sa, "--") == 0) { + return 1; + } + if (strcmp(*sb, "--") == 0) { + /* Always sort "--" to the end */ + return -1; + } + return strcmp(*sa, *sb); } @@ -3199,17 +3203,6 @@ void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) 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; -} - /* ----------------------------------------------------------------------------- * ScriptLine Object * @@ -3611,7 +3604,7 @@ static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script, /* Every object is initially a string of type 'source', but the * internal type may be specialized during execution of the * script. */ - JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line); + Jim_SetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line); token++; } } @@ -3694,6 +3687,39 @@ static int JimParseCheckMissing(Jim_Interp *interp, int ch) return JIM_ERR; } +Jim_Obj *Jim_GetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, int *lineptr) +{ + int line; + Jim_Obj *fileNameObj; + + if (objPtr->typePtr == &sourceObjType) { + fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; + line = objPtr->internalRep.sourceValue.lineNumber; + } + else if (objPtr->typePtr == &scriptObjType) { + ScriptObj *script = JimGetScript(interp, objPtr); + fileNameObj = script->fileNameObj; + line = script->firstline; + } + else { + fileNameObj = interp->emptyObj; + line = 1; + } + *lineptr = line; + return fileNameObj; +} + +void Jim_SetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *fileNameObj, int lineNumber) +{ + JimPanic((Jim_IsShared(objPtr), "Jim_SetSourceInfo called with shared object")); + Jim_FreeIntRep(interp, objPtr); + Jim_IncrRefCount(fileNameObj); + objPtr->internalRep.sourceValue.fileNameObj = fileNameObj; + objPtr->internalRep.sourceValue.lineNumber = lineNumber; + objPtr->typePtr = &sourceObjType; +} + /** * Similar to ScriptObjAddTokens(), but for subst objects. */ @@ -3732,12 +3758,12 @@ static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) struct JimParserCtx parser; struct ScriptObj *script; ParseTokenList tokenlist; - int line = 1; + Jim_Obj *fileNameObj; + int line; + int oldtaint; /* Try to get information about filename / line number */ - if (objPtr->typePtr == &sourceObjType) { - line = objPtr->internalRep.sourceValue.lineNumber; - } + fileNameObj = Jim_GetSourceInfo(interp, objPtr, &line); /* Initially parse the script into tokens (in tokenlist) */ ScriptTokenListInit(&tokenlist); @@ -3753,15 +3779,15 @@ static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0); /* Create the "real" script tokens from the parsed tokens */ + + /* Set the correct taint on the objects in the script */ + oldtaint = interp->taint; + interp->taint = objPtr->taint; + 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; - } + script->fileNameObj = fileNameObj; Jim_IncrRefCount(script->fileNameObj); script->missing = parser.missing.ch; script->linenr = parser.missing.line; @@ -3775,6 +3801,8 @@ static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) Jim_FreeIntRep(interp, objPtr); Jim_SetIntRepPtr(objPtr, script); objPtr->typePtr = &scriptObjType; + + interp->taint = oldtaint; } /** @@ -3820,7 +3848,7 @@ static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr) static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr) { if (--cmdPtr->inUse == 0) { - if (cmdPtr->isproc) { + if (cmdPtr->flags & JIM_CMD_ISPROC) { Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr); Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr); Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj); @@ -3981,7 +4009,7 @@ static int JimCommandsHT_KeyCompare(void *privdata, const void *key1, const void 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; + return len1 == len2 && *str1 == *str2 && memcmp(str1, str2, len1) == 0; } static void JimCommandsHT_ValDestructor(void *interp, void *val) @@ -4089,30 +4117,48 @@ static void JimCreateCommand(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Cmd *c Jim_ReplaceHashEntry(&interp->commands, nameObjPtr, cmd); } -int Jim_CreateCommandObj(Jim_Interp *interp, Jim_Obj *cmdNameObj, - Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc) +/* commands */ +Jim_Cmd *Jim_RegisterCommand(Jim_Interp *interp, Jim_Obj *cmdNameObj, + Jim_CmdProc *cmdProc, + Jim_DelCmdProc *delProc, + const char *usage, + const char *help, + short minargs, + short maxargs, + int flags, + void *privData) { + JimPanic(((flags & JIM_CMD_ISPROC), "Jim_RegisterCommand called with JIM_CMD_ISPROC flag")); Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr)); /* Store the new details for this command */ memset(cmdPtr, 0, sizeof(*cmdPtr)); cmdPtr->inUse = 1; + cmdPtr->flags = flags; cmdPtr->u.native.delProc = delProc; cmdPtr->u.native.cmdProc = cmdProc; + cmdPtr->u.native.usage = usage; + cmdPtr->u.native.help = help; + cmdPtr->u.native.minargs = minargs; + cmdPtr->u.native.maxargs = maxargs; cmdPtr->u.native.privData = privData; Jim_IncrRefCount(cmdNameObj); JimCreateCommand(interp, cmdNameObj, cmdPtr); Jim_DecrRefCount(interp, cmdNameObj); - return JIM_OK; + return cmdPtr; } - +/* This remains for backward compatiblity to create a command + * with no arg limitations or usage/help. + * Prefer one of the Jim_Register* variants instead. + */ 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); + Jim_RegisterCmd(interp, cmdNameStr, NULL, 0, -1, cmdProc, delProc, privData, 0); + return JIM_OK; } static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr) @@ -4233,7 +4279,7 @@ static const char *Jim_memrchr(const char *p, int c, int len) static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *nameObjPtr) { #ifdef jim_ext_namespace - if (cmdPtr->isproc) { + if (cmdPtr->flags & JIM_CMD_ISPROC) { int len; const char *cmdname = Jim_GetStringNoQualifier(nameObjPtr, &len); /* XXX: Really need JimNamespaceSplit() */ @@ -4272,7 +4318,7 @@ static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr assert(cmdPtr); memset(cmdPtr, 0, sizeof(*cmdPtr)); cmdPtr->inUse = 1; - cmdPtr->isproc = 1; + cmdPtr->flags = JIM_CMD_ISPROC; cmdPtr->u.proc.argListObjPtr = argListObjPtr; cmdPtr->u.proc.argListLen = argListLen; cmdPtr->u.proc.bodyObjPtr = bodyObjPtr; @@ -4493,7 +4539,7 @@ Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags) Jim_IncrRefCount(interp->framePtr->nsObj); Jim_DecrRefCount(interp, qualifiedNameObj); } - while (cmd->u.proc.upcall) { + while ((cmd->flags & JIM_CMD_ISPROC) && cmd->u.proc.upcall) { cmd = cmd->prevCmd; } return cmd; @@ -4586,7 +4632,7 @@ static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) /* -------------------- Variables related functions ------------------------- */ 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_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags); static int JimSetNewVariable(Jim_HashTable *ht, Jim_Obj *nameObjPtr, Jim_VarVal *vv) { @@ -4653,15 +4699,18 @@ static Jim_VarVal *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Ji */ int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr) { - int err; + int ret = JIM_OK; Jim_VarVal *vv; switch (SetVariableFromAny(interp, nameObjPtr)) { case JIM_DICT_SUGAR: - return JimDictSugarSet(interp, nameObjPtr, valObjPtr); + ret = JimDictSugarSet(interp, nameObjPtr, valObjPtr); + break; case JIM_ERR: - JimCreateVariable(interp, nameObjPtr, valObjPtr); + if (JimCreateVariable(interp, nameObjPtr, valObjPtr) == NULL) { + ret = JIM_ERR; + } break; case JIM_OK: @@ -4676,13 +4725,16 @@ int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr) savedCallFrame = interp->framePtr; interp->framePtr = vv->linkFramePtr; - err = Jim_SetVariable(interp, vv->objPtr, valObjPtr); + ret = Jim_SetVariable(interp, vv->objPtr, valObjPtr); interp->framePtr = savedCallFrame; - if (err != JIM_OK) - return err; } + break; } - return JIM_OK; + if (ret != JIM_OK && valObjPtr->refCount == 0) { + /* Since we couldn't take ownership of the object, need to free it here */ + Jim_FreeNewObj(interp, valObjPtr); + } + return ret; } int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr) @@ -4977,6 +5029,7 @@ static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr, JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str)); varObjPtr = Jim_NewStringObj(interp, str, p - str); + varObjPtr->taint = objPtr->taint; p++; keyLen = (str + len) - p; @@ -4986,6 +5039,7 @@ static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr, /* Create the objects with the variable name and key. */ keyObjPtr = Jim_NewStringObj(interp, p, keyLen); + keyObjPtr->taint = objPtr->taint; Jim_IncrRefCount(varObjPtr); Jim_IncrRefCount(keyObjPtr); @@ -5205,7 +5259,7 @@ static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands) } Jim_DecrRefCount(interp, cmdNameObj); } - Jim_FreeStack(localCommands); + Jim_StackFree(localCommands); Jim_Free(localCommands); } return JIM_OK; @@ -5809,6 +5863,9 @@ void Jim_FreeInterp(Jim_Interp *i) JimFreeCallFrame(i, cf, JIM_FCF_FULL); } + /* Must be done before freeing singletons */ + Jim_FreeHashTable(&i->commands); + Jim_DecrRefCount(i, i->emptyObj); Jim_DecrRefCount(i, i->trueObj); Jim_DecrRefCount(i, i->falseObj); @@ -5820,8 +5877,6 @@ void Jim_FreeInterp(Jim_Interp *i) Jim_DecrRefCount(i, i->nullScriptObj); Jim_DecrRefCount(i, i->currentFilenameObj); - Jim_FreeHashTable(&i->commands); - /* This will disard any cached commands */ Jim_InterpIncrProcEpoch(i); @@ -6009,7 +6064,7 @@ static Jim_Obj *JimProcForEvalFrame(Jim_Interp *interp, Jim_EvalFrame *frame) if (frame == interp->evalFrame || (frame->cmd && frame->cmd->cmdNameObj)) { Jim_EvalFrame *e; for (e = frame->parent; e; e = e->parent) { - if (e->cmd && e->cmd->isproc && e->cmd->cmdNameObj) { + if (e->cmd && (e->cmd->flags & JIM_CMD_ISPROC) && e->cmd->cmdNameObj) { break; } } @@ -6048,12 +6103,12 @@ static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj) Jim_IncrRefCount(stackTraceObj); Jim_DecrRefCount(interp, interp->stackTrace); interp->stackTrace = stackTraceObj; - interp->errorFlag = 1; + interp->hasErrorStackTrace = 1; } static void JimSetErrorStack(Jim_Interp *interp, ScriptObj *script) { - if (!interp->errorFlag) { + if (!interp->hasErrorStackTrace) { int i; Jim_Obj *stackTrace = Jim_NewListObj(interp, NULL, 0); @@ -6283,6 +6338,7 @@ Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue) objPtr = Jim_NewObj(interp); objPtr->typePtr = &intObjType; objPtr->bytes = NULL; + objPtr->taint = 0; objPtr->internalRep.wideValue = wideValue; return objPtr; } @@ -6431,6 +6487,7 @@ Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue) objPtr = Jim_NewObj(interp); objPtr->typePtr = &doubleObjType; objPtr->bytes = NULL; + objPtr->taint = 0; objPtr->internalRep.doubleValue = doubleValue; return objPtr; } @@ -6812,14 +6869,7 @@ static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) } /* Try to preserve information about filename / line number */ - if (objPtr->typePtr == &sourceObjType) { - fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; - linenr = objPtr->internalRep.sourceValue.lineNumber; - } - else { - fileNameObj = interp->emptyObj; - linenr = 1; - } + fileNameObj = Jim_GetSourceInfo(interp, objPtr, &linenr); Jim_IncrRefCount(fileNameObj); /* Get the string representation */ @@ -6843,7 +6893,8 @@ static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC) continue; elementPtr = JimParserGetTokenObj(interp, &parser); - JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline); + Jim_SetSourceInfo(interp, elementPtr, fileNameObj, parser.tline); + elementPtr->taint = objPtr->taint; ListAppendElement(objPtr, elementPtr); } } @@ -6858,6 +6909,7 @@ Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len) objPtr = Jim_NewObj(interp); objPtr->typePtr = &listObjType; objPtr->bytes = NULL; + objPtr->taint = 0; objPtr->internalRep.listValue.ele = NULL; objPtr->internalRep.listValue.len = 0; objPtr->internalRep.listValue.maxLen = 0; @@ -6904,7 +6956,8 @@ struct lsort_info { JIM_LSORT_NOCASE, JIM_LSORT_INTEGER, JIM_LSORT_REAL, - JIM_LSORT_COMMAND + JIM_LSORT_COMMAND, + JIM_LSORT_DICT } type; int order; Jim_Obj **indexv; @@ -6937,6 +6990,45 @@ static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj) return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order; } +static int ListSortDict(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + /* XXX Does not compare past embedded nulls */ + const char *left = Jim_String(*lhsObj); + const char *right = Jim_String(*rhsObj); + + while (1) { + if (isdigit(UCHAR(*left)) && isdigit(UCHAR(*right))) { + /* extract and compare integers */ + jim_wide lint, rint; + char *lend, *rend; + lint = jim_strtoull(left, &lend); + rint = jim_strtoull(right, &rend); + if (lint != rint) { + return JimSign(lint - rint) * sort_info->order; + } + /* If the integers are equal but of unequal length, then one must have more leading + * zeros. The shorter one compares less */ + if (lend -left != rend - right) { + return JimSign((lend - left) - (rend - right)) * sort_info->order; + } + left = lend; + right = rend; + } + else { + int cl, cr; + left += utf8_tounicode_case(left, &cl, 1); + right += utf8_tounicode_case(right, &cr, 1); + if (cl != cr) { + return JimSign(cl - cr) * sort_info->order; + } + if (cl == 0) { + /* If they compare equal, use a case sensitive comparison as a tie breaker */ + return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order; + } + } + } +} + static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj) { jim_wide lhs = 0, rhs = 0; @@ -7056,6 +7148,9 @@ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsor case JIM_LSORT_COMMAND: fn = ListSortCommand; break; + case JIM_LSORT_DICT: + fn = ListSortDict; + break; default: fn = NULL; /* avoid warning */ JimPanic((1, "ListSort called with invalid sort type")); @@ -7134,6 +7229,7 @@ static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *co memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *)); for (i = 0; i < elemc; ++i) { point[i] = elemVec[i]; + listPtr->taint |= point[i]->taint; Jim_IncrRefCount(point[i]); } listPtr->internalRep.listValue.len += elemc; @@ -7282,6 +7378,7 @@ static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, idx = listPtr->internalRep.listValue.len + idx; Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]); listPtr->internalRep.listValue.ele[idx] = newObjPtr; + listPtr->taint |= newObjPtr->taint; Jim_IncrRefCount(newObjPtr); return JIM_OK; } @@ -7322,8 +7419,9 @@ int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr, goto err; Jim_InvalidateStringRep(objPtr); Jim_InvalidateStringRep(varObjPtr); - if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) - goto err; + if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) { + return JIM_ERR; + } Jim_SetResult(interp, varObjPtr); return JIM_OK; err: @@ -7820,6 +7918,7 @@ static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, dict->table[dict->len++] = valueObjPtr; } + objPtr->taint |= keyObjPtr->taint | valueObjPtr->taint; return JIM_OK; } } @@ -7958,7 +8057,6 @@ int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr, } varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0); if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) { - Jim_FreeNewObj(interp, varObjPtr); return JIM_ERR; } } @@ -7979,6 +8077,9 @@ int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr, goto err; } } + if (newObjPtr) { + varObjPtr->taint |= newObjPtr->taint; + } break; } @@ -8010,7 +8111,7 @@ int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr, Jim_InvalidateStringRep(objPtr); Jim_InvalidateStringRep(varObjPtr); if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) { - goto err; + return JIM_ERR; } if (!(flags & JIM_NORESULT)) { @@ -8253,6 +8354,9 @@ enum /* Binary operators (strings) */ JIM_EXPROP_STREQ, /* 43 */ JIM_EXPROP_STRNE, + JIM_EXPROP_STRGLOB, + JIM_EXPROP_STRRE, + JIM_EXPROP_STRIN, JIM_EXPROP_STRNI, JIM_EXPROP_STRLT, @@ -8261,13 +8365,13 @@ enum JIM_EXPROP_STRGE, /* Unary operators (numbers) */ - JIM_EXPROP_NOT, /* 51 */ + JIM_EXPROP_NOT, /* 53 */ JIM_EXPROP_BITNOT, JIM_EXPROP_UNARYMINUS, JIM_EXPROP_UNARYPLUS, /* Functions */ - JIM_EXPROP_FUNC_INT, /* 55 */ + JIM_EXPROP_FUNC_INT, /* 57 */ JIM_EXPROP_FUNC_WIDE, JIM_EXPROP_FUNC_ABS, JIM_EXPROP_FUNC_DOUBLE, @@ -8276,7 +8380,7 @@ enum JIM_EXPROP_FUNC_SRAND, /* math functions from libm */ - JIM_EXPROP_FUNC_SIN, /* 69 */ + JIM_EXPROP_FUNC_SIN, /* 71 */ JIM_EXPROP_FUNC_COS, JIM_EXPROP_FUNC_TAN, JIM_EXPROP_FUNC_ASIN, @@ -8399,6 +8503,13 @@ static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprNode *node) case JIM_EXPROP_NOT: wC = !bA; break; + case JIM_EXPROP_UNARYPLUS: + case JIM_EXPROP_UNARYMINUS: + rc = JIM_ERR; + Jim_SetResultFormatted(interp, + "can't use non-numeric string as operand of \"%s\"", + node->type == JIM_EXPROP_UNARYPLUS ? "+" : "-"); + break; default: abort(); } @@ -8842,7 +8953,25 @@ static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valOb return 0; } +static int JimRegexpMatch(Jim_Interp *interp, Jim_Obj *patternObj, Jim_Obj *objPtr) +{ + Jim_Obj *argv[3]; + int argc = 0; + long eq; + int rc; + + argv[argc++] = Jim_NewStringObj(interp, "regexp", -1); + argv[argc++] = patternObj; + argv[argc++] = objPtr; + + rc = Jim_EvalObjVector(interp, argc, argv); + + if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) { + eq = -rc; + } + return eq; +} static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node) { @@ -8887,11 +9016,22 @@ static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprNode *node) case JIM_EXPROP_STRNI: wC = !JimSearchList(interp, B, A); break; + case JIM_EXPROP_STRGLOB: + wC = Jim_StringMatchObj(interp, B, A, 0); + break; + case JIM_EXPROP_STRRE: + wC = JimRegexpMatch(interp, B, A); + if (wC < 0) { + rc = JIM_ERR; + goto error; + } + break; default: abort(); } Jim_SetResultInt(interp, wC); +error: Jim_DecrRefCount(interp, A); Jim_DecrRefCount(interp, B); @@ -9022,6 +9162,8 @@ static const struct Jim_ExprOperator Jim_ExprOperators[] = { OPRINIT("eq", 60, 2, JimExprOpStrBin), OPRINIT("ne", 60, 2, JimExprOpStrBin), + OPRINIT("=*", 60, 2, JimExprOpStrBin), + OPRINIT("=~", 60, 2, JimExprOpStrBin), OPRINIT("in", 55, 2, JimExprOpStrBin), OPRINIT("ni", 55, 2, JimExprOpStrBin), @@ -9290,7 +9432,7 @@ static int JimParseExprOperator(struct JimParserCtx *pc) return JIM_OK; } -#if (defined(DEBUG_SHOW_SCRIPT) || defined(DEBUG_SHOW_SCRIPT_TOKENS) || defined(JIM_DEBUG_COMMAND) || defined(DEBUG_SHOW_SUBST)) && !defined(JIM_BOOTSTRAP) +#if defined(JIM_TT_NAME) && !defined(JIM_BOOTSTRAP) static const char *jim_tt_name(int type) { static const char * const tt_names[JIM_TT_EXPR_OP] = @@ -9642,7 +9784,7 @@ missingoperand: objPtr = Jim_NewStringObj(interp, t->token, t->len); if (t->type == JIM_TT_CMD) { /* Only commands need source info */ - JimSetSourceInfo(interp, objPtr, builder->fileNameObj, t->line); + Jim_SetSourceInfo(interp, objPtr, builder->fileNameObj, t->line); } } @@ -9696,7 +9838,7 @@ static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenL 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); + Jim_StackInit(&builder.stack, NULL); rc = ExprTreeBuildTree(interp, &builder, 0, 0, 1); @@ -9710,7 +9852,7 @@ static struct ExprTree *ExprTreeCreateTree(Jim_Interp *interp, const ParseTokenL } /* Free the stack used for the compilation. */ - Jim_FreeStack(&builder.stack); + Jim_StackFree(&builder.stack); if (rc != JIM_OK) { ExprTreeFreeNodes(interp, builder.nodes, builder.next - builder.nodes); @@ -9742,18 +9884,14 @@ static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) int rc = JIM_ERR; /* Try to get information about filename / line number */ - if (objPtr->typePtr == &sourceObjType) { - fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; - line = objPtr->internalRep.sourceValue.lineNumber; - } - else { - fileNameObj = interp->emptyObj; - line = 1; - } + fileNameObj = Jim_GetSourceInfo(interp, objPtr, &line); Jim_IncrRefCount(fileNameObj); exprText = Jim_GetString(objPtr, &exprTextLen); + int oldtaint = interp->taint; + interp->taint = objPtr->taint; + /* Initially tokenise the expression into tokenlist */ ScriptTokenListInit(&tokenlist); @@ -9820,6 +9958,9 @@ static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) Jim_FreeIntRep(interp, objPtr); Jim_SetIntRepPtr(objPtr, expr); objPtr->typePtr = &exprObjType; + + interp->taint = oldtaint; + return rc; } @@ -10692,10 +10833,6 @@ static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg 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_GetWideExpr(interp, argv[2], &increment) != JIM_OK) return JIM_ERR; @@ -10711,7 +10848,6 @@ static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg 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; } } @@ -10878,12 +11014,17 @@ tailcall: (retcode = JimTraceCallback(interp, "cmd", objc, objv)) == JIM_OK) { /* Call it -- Make sure result is an empty object. */ Jim_SetEmptyResult(interp); - if (cmdPtr->isproc) { + interp->taint = Jim_CalcTaint(objc, objv); + if (cmdPtr->flags & JIM_CMD_ISPROC) { retcode = JimCallProcedure(interp, cmdPtr, objc, objv); } + else if ((cmdPtr->flags & JIM_CMD_NOTAINT) && Jim_CheckTaint(interp, JIM_TAINT_ANY)) { + Jim_SetTaintError(interp, 1, objv); + retcode = JIM_ERR; + } else { - interp->cmdPrivData = cmdPtr->u.native.privData; - retcode = cmdPtr->u.native.cmdProc(interp, objc, objv); + retcode = JimCallNative(interp, cmdPtr, objc, objv); + /* XXX Could it return -2 for tainted? */ } if (retcode == JIM_ERR) { JimSetErrorStack(interp, NULL); @@ -11045,6 +11186,8 @@ static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * tok Jim_Obj *sintv[JIM_EVAL_SINTV_LEN]; Jim_Obj *objPtr; char *s; + int taint = 0; + const char *error_action = NULL; if (tokens <= JIM_EVAL_SINTV_LEN) intv = sintv; @@ -11064,14 +11207,16 @@ static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * tok tokens = i; continue; } - /* XXX: Should probably set an error about break outside loop */ + error_action = "break"; /* fall through to error */ case JIM_CONTINUE: if (flags & JIM_SUBST_FLAG) { intv[i] = NULL; continue; } - /* XXX: Ditto continue outside loop */ + if (!error_action) { + error_action = "continue"; + } /* fall through to error */ default: while (i--) { @@ -11080,8 +11225,12 @@ static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * tok if (intv != sintv) { Jim_Free(intv); } + if (error_action) { + Jim_SetResultFormatted(interp, "invoked \"%s\" outside of a loop", error_action); + } return NULL; } + taint |= intv[i]->taint; Jim_IncrRefCount(intv[i]); Jim_String(intv[i]); totlen += intv[i]->length; @@ -11097,6 +11246,7 @@ static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * tok /* Concatenate every token in an unique * object. */ objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0); + objPtr->taint = taint; if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC && token[2].type == JIM_TT_VAR) { @@ -11108,7 +11258,9 @@ static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * tok } else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) { /* The first interpolated token is source, so preserve the source info */ - JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber); + int line; + Jim_Obj *fileNameObj = Jim_GetSourceInfo(interp, intv[0], &line); + Jim_SetSourceInfo(interp, objPtr, fileNameObj, line); } @@ -11130,6 +11282,117 @@ static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * tok return objPtr; } +#define JIM_LSUBST_LINE 0x0001 + +/* Parse a string as an 'lsubst' argument and sets the interp result. + * Return JIM_OK if ok, or JIM_ERR on error. + * + * Modelled on Jim_EvalObj() + * + * If flags contains JIM_LSUBST_LINE, each "statement" is returned as list of {command arg...} + */ +static int JimListSubstObj(Jim_Interp *interp, struct Jim_Obj *objPtr, unsigned flags) +{ + int i; + ScriptObj *script; + ScriptToken *token; + Jim_Obj *resultListObj; + int retcode = JIM_OK; + + Jim_IncrRefCount(objPtr); /* Make sure it's shared. */ + script = JimGetScript(interp, objPtr); + if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) { + JimSetErrorStack(interp, script); + Jim_DecrRefCount(interp, objPtr); + return JIM_ERR; + } + + token = script->token; + + script->inUse++; + + /* Build the result list here */ + resultListObj = Jim_NewListObj(interp, NULL, 0); + + /* Add every command, arg to the result list */ + for (i = 0; i < script->len && retcode == JIM_OK; ) { + int argc; + int j; + Jim_Obj *lineListObj = resultListObj; + + /* First token of the line is always JIM_TT_LINE */ + argc = token[i].objPtr->internalRep.scriptLineValue.argc; + script->linenr = token[i].objPtr->internalRep.scriptLineValue.line; + + /* Skip the JIM_TT_LINE token */ + i++; + + if (flags & JIM_LSUBST_LINE) { + lineListObj = Jim_NewListObj(interp, NULL, 0); + } + + /* Extract the words from this line */ + 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; + } + } + + /* Note we don't worry about a fast path here */ + 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) { + Jim_ListAppendElement(interp, lineListObj, wordObjPtr); + } + else { + int k; + /* Need to add each word of wordObjPtr list to the result list */ + for (k = 0; k < Jim_ListLength(interp, wordObjPtr); k++) { + Jim_ListAppendElement(interp, lineListObj, Jim_ListGetIndex(interp, wordObjPtr, k)); + } + } + Jim_DecrRefCount(interp, wordObjPtr); + } + + if (flags & JIM_LSUBST_LINE) { + Jim_ListAppendElement(interp, resultListObj, lineListObj); + } + } + + /* Note that we don't have to decrement inUse, because the + * following code transfers our use of the reference again to + * the script object. */ + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &scriptObjType; + Jim_SetIntRepPtr(objPtr, script); + Jim_DecrRefCount(interp, objPtr); + + if (retcode == JIM_OK) { + Jim_SetResult(interp, resultListObj); + } + else { + Jim_FreeNewObj(interp, resultListObj); + } + + return retcode; +} /* listPtr *must* be a list. * The contents of the list is evaluated with the first element as the command and @@ -11204,7 +11467,7 @@ int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr) } if (script->len == 3 && token[1].objPtr->typePtr == &commandObjType - && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0 + && (token[1].objPtr->internalRep.cmdValue.cmdPtr->flags & JIM_CMD_ISPROC) == 0 && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand && token[2].objPtr->typePtr == &variableObjType) { @@ -11234,7 +11497,7 @@ int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr) JimPushEvalFrame(interp, &frame, scriptObjPtr); /* Collect a new error stack trace if an error occurs */ - interp->errorFlag = 0; + interp->hasErrorStackTrace = 0; argv = sargv; /* Execute every command sequentially until the end of the script @@ -11365,6 +11628,7 @@ int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr) if (retcode == JIM_OK && argc) { /* Invoke the command */ retcode = JimInvokeCommand(interp, argc, argv); + interp->taint = 0; /* Check for a signal after each command */ if (Jim_CheckSignal(interp)) { retcode = JIM_SIGNAL; @@ -11429,46 +11693,64 @@ static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argVa return retcode; } -/** - * Sets the interp result to be an error message indicating the required proc args. +/* Returns a zero-ref count usage string for the command. + * If no usage is availabe, just returns "cmd ..." */ -static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd) +static Jim_Obj *JimCmdUsage(Jim_Interp *interp, Jim_Obj *cmdNameObj, Jim_Cmd *cmd) { - /* Create a nice error message, consistent with Tcl 8.5 */ - Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0); - int i; + Jim_Obj *usage = Jim_DuplicateObj(interp, cmdNameObj); - 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) { - /* Renamed args */ - Jim_AppendString(interp, argmsg, "?", 1); - Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr); - Jim_AppendString(interp, argmsg, " ...?", -1); - } - else { - /* We have plain args */ - 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); + if (cmd->flags & JIM_CMD_ISPROC) { + int i; + for (i = 0; i < cmd->u.proc.argListLen; i++) { + Jim_AppendString(interp, usage, " ", 1); + + if (i == cmd->u.proc.argsPos) { + if (cmd->u.proc.arglist[i].defaultObjPtr) { + /* Renamed args */ + Jim_AppendString(interp, usage, "?", 1); + Jim_AppendObj(interp, usage, cmd->u.proc.arglist[i].defaultObjPtr); + Jim_AppendString(interp, usage, " ...?", -1); + } + else { + /* We have plain args */ + Jim_AppendString(interp, usage, "?arg ...?", -1); + } } else { - const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr); - if (*arg == '&') { - arg++; + if (cmd->u.proc.arglist[i].defaultObjPtr) { + Jim_AppendString(interp, usage, "?", 1); + Jim_AppendObj(interp, usage, cmd->u.proc.arglist[i].nameObjPtr); + Jim_AppendString(interp, usage, "?", 1); + } + else { + const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr); + if (*arg == '&') { + arg++; + } + Jim_AppendString(interp, usage, arg, -1); } - Jim_AppendString(interp, argmsg, arg, -1); } } } - Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg); + else if (cmd->u.native.usage) { + if (*cmd->u.native.usage) { + Jim_AppendStrings(interp, usage, " ", cmd->u.native.usage, NULL); + } + } + else { + Jim_AppendString(interp, usage, " ...", -1); + } + + return usage; +} + +/** + * Sets the interp result to be an error message indicating the required proc args. + */ +static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd) +{ + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", JimCmdUsage(interp, procNameObj, cmd)); } #ifdef jim_ext_namespace @@ -11621,6 +11903,36 @@ badargset: return retcode; } +static int JimCallNative(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv) +{ + int argsok = 1; + int ret; + + /* Check arg count */ + if (argc - 1 < cmd->u.native.minargs) { + argsok = 0; + } + else if (cmd->u.native.maxargs >= 0 && argc - 1 > cmd->u.native.maxargs) { + argsok = 0; + } + else if (cmd->u.native.maxargs < -1 && (argc - 1) % -cmd->u.native.maxargs != 0) { + /* -2 means must have n * 2 args */ + argsok = 0; + } + if (argsok) { + interp->cmdPrivData = cmd->u.native.privData; + ret = cmd->u.native.cmdProc(interp, argc, argv); + if (ret != JIM_USAGE) { + return ret; + } + /* This means an argument error */ + } + + //printf("Wrong args for %s, argc=%d, minargs=%d, maxargs=%d\n", Jim_String(argv[0]), argc, cmd->u.native.minargs, cmd->u.native.maxargs); + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", JimCmdUsage(interp, argv[0], cmd)); + return JIM_ERR; +} + int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script) { int retval; @@ -11629,7 +11941,7 @@ int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const c scriptObjPtr = Jim_NewStringObj(interp, script, -1); Jim_IncrRefCount(scriptObjPtr); if (filename) { - JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno); + Jim_SetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno); } retval = Jim_EvalObj(interp, scriptObjPtr); Jim_DecrRefCount(interp, scriptObjPtr); @@ -11673,51 +11985,38 @@ int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename) * Reads the text file contents into an object and returns with a zero ref count. * Returns NULL and sets an error if can't read the file. */ -static Jim_Obj *JimReadTextFile(Jim_Interp *interp, const char *filename) +int Jim_EvalFile(Jim_Interp *interp, const char *filename) { - jim_stat_t sb; - int fd; + FILE *fp; char *buf; + Jim_Obj *scriptObjPtr; + Jim_Obj *filenameObj, *oldFilenameObj; + int retcode = JIM_ERR; int readlen; +#define READ_BUF_SIZE 256 - if (Jim_Stat(filename, &sb) == -1 || (fd = open(filename, O_RDONLY | O_TEXT, 0666)) < 0) { + if ((fp = fopen(filename, "rt")) == NULL) { Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno)); - return NULL; - } - buf = Jim_Alloc(sb.st_size + 1); - readlen = read(fd, buf, sb.st_size); - close(fd); - if (readlen < 0) { - Jim_Free(buf); - Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno)); - return NULL; + return JIM_ERR; } - else { - Jim_Obj *objPtr; - buf[readlen] = 0; + scriptObjPtr = Jim_NewStringObj(interp, NULL, 0); - objPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen); - - return objPtr; + buf = Jim_Alloc(READ_BUF_SIZE); + while ((readlen = fread(buf, 1, READ_BUF_SIZE, fp)) > 0) { + Jim_AppendString(interp, scriptObjPtr, buf, readlen); } -} - - -int Jim_EvalFile(Jim_Interp *interp, const char *filename) -{ - Jim_Obj *filenameObj; - Jim_Obj *oldFilenameObj; - Jim_Obj *scriptObjPtr; - int retcode; - - scriptObjPtr = JimReadTextFile(interp, filename); - if (!scriptObjPtr) { - return JIM_ERR; + Jim_Free(buf); + if (ferror(fp)) { + fclose(fp); + Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno)); + Jim_FreeNewObj(interp, scriptObjPtr); + return retcode; } + fclose(fp); + /* Convert the stringObjType to a sourceObjType with filename and line */ filenameObj = Jim_NewStringObj(interp, filename, -1); - JimSetSourceInfo(interp, scriptObjPtr, filenameObj, 1); - + Jim_SetSourceInfo(interp, scriptObjPtr, filenameObj, 1); oldFilenameObj = JimPushInterpObj(interp->currentFilenameObj, filenameObj); retcode = Jim_EvalObj(interp, scriptObjPtr); @@ -11798,6 +12097,7 @@ static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags struct JimParserCtx parser; struct ScriptObj *script = Jim_Alloc(sizeof(*script)); ParseTokenList tokenlist; + int oldtaint; /* Initially parse the subst into tokens (in tokenlist) */ ScriptTokenListInit(&tokenlist); @@ -11813,6 +12113,9 @@ static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags parser.tline); } + oldtaint = interp->taint; + interp->taint = objPtr->taint; + /* Create the "real" subst/script tokens from the initial token list */ script->inUse = 1; script->substFlags = flags; @@ -11839,6 +12142,7 @@ static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags Jim_FreeIntRep(interp, objPtr); Jim_SetIntRepPtr(objPtr, script); objPtr->typePtr = &scriptObjType; + interp->taint = oldtaint; return JIM_OK; } @@ -11878,23 +12182,62 @@ int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPt /* ----------------------------------------------------------------------------- * Core commands utility functions * ---------------------------------------------------------------------------*/ -void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg) +static Jim_Obj *JimJoinCmdArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { 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_IncrRefCount(objPtr); + + return objPtr; +} + + /* This function should not be necessary for simple commands. + * Instead set minargs/maxargs and a usage string when registering the command and + * optionally return JIM_USAGE from the command proc to generate a usage message. + */ +void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg) +{ + Jim_Obj *objPtr = JimJoinCmdArgs(interp, argc, argv); + if (*msg) { + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s %s\"", objPtr, msg); + } + else { + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr); + } + Jim_DecrRefCount(interp, objPtr); +} + +/** + * Calculates the taint of the given objects (skipping NULL entries). + */ +int Jim_CalcTaint(int argc, Jim_Obj *const *argv) +{ + int taint = 0; +#ifdef JIM_TAINT + int i; + for (i = 0; i < argc; i++) { + if (argv[i]) { + taint |= argv[i]->taint; + } + } +#endif + return taint; +} - Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr); +void Jim_SetTaintError(Jim_Interp *interp, int cmdargs, Jim_Obj *const *argv) +{ +#ifdef JIM_TAINT + Jim_Obj *objPtr = JimJoinCmdArgs(interp, cmdargs, argv); + Jim_SetResultFormatted(interp, "%#s: tainted data", objPtr); + Jim_DecrRefCount(interp, objPtr); + Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "TAINTED", -1)); +#endif } /** @@ -11936,9 +12279,12 @@ static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, } /* Keep these in order */ -#define JIM_CMDLIST_COMMANDS 0 -#define JIM_CMDLIST_PROCS 1 -#define JIM_CMDLIST_CHANNELS 2 +#define JIM_CMDLIST_COMMANDS 1 +#define JIM_CMDLIST_PROCS 2 +#define JIM_CMDLIST_ALIASES 4 +#define JIM_CMDLIST_CHANNELS 8 + +#define JIM_CMDLIST_ALL 0x1000 /** * Adds matching command names (procs, channels) to the list. @@ -11947,30 +12293,40 @@ static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *keyObj, void *value, Jim_Obj *patternObj, int type) { Jim_Cmd *cmdPtr = (Jim_Cmd *)value; + int match = 1; - if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) { + if ((type & JIM_CMDLIST_PROCS) && !(cmdPtr->flags & JIM_CMD_ISPROC)) { /* not a proc */ return; } + if ((type & JIM_CMDLIST_CHANNELS) && !(cmdPtr->flags & JIM_CMD_ISCHANNEL)) { + /* not a channel */ + return; + } + if ((type & JIM_CMDLIST_ALIASES) && !(cmdPtr->flags & JIM_CMD_ISALIAS)) { + /* not an alias */ + return; + } + if (!(type & JIM_CMDLIST_ALL) && strchr(Jim_String(keyObj), ' ')) { + /* contains a space and not -all */ + return; + } Jim_IncrRefCount(keyObj); - if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, keyObj) >= 0) { - int match = 1; - if (patternObj) { - int plen, slen; - const char *pattern = Jim_GetStringNoQualifier(patternObj, &plen); - const char *str = Jim_GetStringNoQualifier(keyObj, &slen); + if (patternObj) { + int plen, slen; + const char *pattern = Jim_GetStringNoQualifier(patternObj, &plen); + const char *str = Jim_GetStringNoQualifier(keyObj, &slen); #ifdef JIM_NO_INTROSPECTION - /* Only exact match supported with no introspection */ - match = (JimStringCompareUtf8(pattern, plen, str, slen, 0) == 0); + /* Only exact match supported with no introspection */ + match = (JimStringCompareUtf8(pattern, plen, str, slen, 0) == 0); #else - match = JimGlobMatch(pattern, plen, str, slen, 0); + match = JimGlobMatch(pattern, plen, str, slen, 0); #endif - } - if (match) { - Jim_ListAppendElement(interp, listObjPtr, keyObj); - } + } + if (match) { + Jim_ListAppendElement(interp, listObjPtr, keyObj); } Jim_DecrRefCount(interp, keyObj); } @@ -11981,10 +12337,9 @@ static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int } /* Keep these in order */ -#define JIM_VARLIST_GLOBALS 0 -#define JIM_VARLIST_LOCALS 1 -#define JIM_VARLIST_VARS 2 -#define JIM_VARLIST_MASK 0x000f +#define JIM_VARLIST_GLOBALS 1 +#define JIM_VARLIST_LOCALS 2 +#define JIM_VARLIST_VARS 4 #define JIM_VARLIST_VALUES 0x1000 @@ -11996,7 +12351,7 @@ static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, { Jim_VarVal *vv = (Jim_VarVal *)value; - if ((type & JIM_VARLIST_MASK) != JIM_VARLIST_LOCALS || vv->linkFramePtr == NULL) { + if (!(type & JIM_VARLIST_LOCALS) || vv->linkFramePtr == NULL) { if (patternObj == NULL || Jim_StringMatchObj(interp, patternObj, keyObj, 0)) { Jim_ListAppendElement(interp, listObjPtr, keyObj); if (type & JIM_VARLIST_VALUES) { @@ -12009,13 +12364,13 @@ static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, /* mode is JIM_VARLIST_xxx */ static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode) { - if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) { + if ((mode & JIM_VARLIST_LOCALS) && interp->framePtr == interp->topFramePtr) { /* 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; + Jim_CallFrame *framePtr = (mode & JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr; return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode); } @@ -12091,10 +12446,6 @@ static int JimInfoFrame(Jim_Interp *interp, Jim_Obj *levelObjPtr, Jim_Obj **objP /* fake [puts] -- not the real puts, just for debugging. */ 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); @@ -12150,11 +12501,7 @@ static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, i 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 (argc == 2) { /* The arity = 2 case is different. For [- x] returns -x, * while [/ x] returns 1/x. */ if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) { @@ -12249,10 +12596,6 @@ static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv /* [set] */ 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; @@ -12323,11 +12666,6 @@ static int JimCheckLoopRetcode(Jim_Interp *interp, int retval) /* [while] */ 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; - } - /* The general purpose implementation of while starts here */ while (1) { int boolean = 0, retval; @@ -12365,11 +12703,6 @@ static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv Jim_Obj *varNamePtr = NULL; Jim_Obj *stopVarNamePtr = NULL; - if (argc != 5) { - Jim_WrongNumArgs(interp, 1, argv, "start test next body"); - return JIM_ERR; - } - /* Do the initialisation */ if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) { return retval; @@ -12555,15 +12888,10 @@ static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg { int retval; jim_wide i; - jim_wide limit; + jim_wide limit = 0; jim_wide incr = 1; Jim_Obj *bodyObjPtr; - if (argc < 4 || argc > 6) { - Jim_WrongNumArgs(interp, 1, argv, "var ?first? limit ?incr? body"); - return JIM_ERR; - } - retval = Jim_GetWideExpr(interp, argv[2], &i); if (argc > 4 && retval == JIM_OK) { retval = Jim_GetWideExpr(interp, argv[3], &limit); @@ -12616,9 +12944,6 @@ static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg else { objPtr = Jim_NewIntObj(interp, i); retval = Jim_SetVariable(interp, argv[1], objPtr); - if (retval != JIM_OK) { - Jim_FreeNewObj(interp, objPtr); - } } } } @@ -12676,9 +13001,8 @@ static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *arg 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; + if (argc % 2 != 0) { + return JIM_USAGE; } script = argv[argc - 1]; /* Last argument is a script */ numargs = (argc - 1 - 1); /* argc - 'foreach' - script */ @@ -12732,10 +13056,10 @@ static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *arg /* Ran out, so store the empty string */ valObj = interp->emptyObj; } - /* Avoid shimmering */ - Jim_IncrRefCount(valObj); + // XXX + //Jim_IncrRefCount(valObj); result = Jim_SetVariable(interp, varName, valObj); - Jim_DecrRefCount(interp, valObj); + //Jim_DecrRefCount(interp, valObj); if (result != JIM_OK) { goto err; } @@ -12791,11 +13115,6 @@ static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * 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++) { @@ -12821,50 +13140,50 @@ 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) { - /* Far not enough arguments given! */ - if (current >= argc) - goto err; - if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean)) - != JIM_OK) - return retval; - /* There lacks something, isn't it? */ - if (current >= argc) - goto err; - if (Jim_CompareStringImmediate(interp, argv[current], "then")) - current++; - /* Tsk tsk, no then-clause? */ - if (current >= argc) - goto err; - if (boolean) - return Jim_EvalObj(interp, argv[current]); - /* Ok: no else-clause follows */ - if (++current >= argc) { - Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); - return JIM_OK; - } - falsebody = current++; - if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) { - /* IIICKS - else-clause isn't last cmd? */ - if (current != argc - 1) - goto err; - return Jim_EvalObj(interp, argv[current]); + while (1) { + /* not enough arguments given! */ + if (current >= argc) { + return JIM_USAGE; + } + if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean)) + != JIM_OK) + return retval; + /* There lacks something, isn't it? */ + if (current >= argc) { + return JIM_USAGE; + } + if (Jim_CompareStringImmediate(interp, argv[current], "then")) + current++; + /* Tsk tsk, no then-clause? */ + if (current >= argc) { + return JIM_USAGE; + } + if (boolean) + return Jim_EvalObj(interp, argv[current]); + /* Ok: no else-clause follows */ + if (++current >= argc) { + Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); + return JIM_OK; + } + falsebody = current++; + if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) { + /* IIICKS - else-clause isn't last cmd? */ + if (current != argc - 1) { + return JIM_USAGE; } - else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif")) - /* Ok: elseif follows meaning all the stuff - * again (how boring...) */ - continue; - /* OOPS - else-clause is not last cmd? */ - else if (falsebody != argc - 1) - goto err; - return Jim_EvalObj(interp, argv[falsebody]); + return Jim_EvalObj(interp, argv[current]); } - return JIM_OK; + else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif")) + /* Ok: elseif follows meaning all the stuff + * again (how boring...) */ + continue; + /* OOPS - else-clause is not last cmd? */ + else if (falsebody != argc - 1) { + return JIM_USAGE; + } + return Jim_EvalObj(interp, argv[falsebody]); } - err: - Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody"); - return JIM_ERR; + return JIM_OK; } @@ -12907,12 +13226,6 @@ static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a 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]); @@ -12933,7 +13246,7 @@ static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a else if (strncmp(option, "-command", 2) == 0) { matchOpt = SWITCH_CMD; if ((argc - opt) < 2) - goto wrongnumargs; + return JIM_USAGE; command = argv[++opt]; } else { @@ -12943,7 +13256,7 @@ static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a return JIM_ERR; } if ((argc - opt) < 2) - goto wrongnumargs; + return JIM_USAGE; } strObj = argv[opt++]; patCount = argc - opt; @@ -12953,7 +13266,7 @@ static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a else caseList = (Jim_Obj **)&argv[opt]; if (patCount == 0 || patCount % 2 != 0) - goto wrongnumargs; + return JIM_USAGE; for (i = 0; scriptObj == NULL && i < patCount; i += 2) { Jim_Obj *patObj = caseList[i]; @@ -13023,10 +13336,6 @@ static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a Jim_Obj *objPtr; int ret; - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?"); - return JIM_ERR; - } ret = Jim_ListIndices(interp, argv[1], argv + 2, argc - 2, &objPtr, JIM_NONE); if (ret < 0) { /* Returns an empty object if the index @@ -13043,10 +13352,6 @@ static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a /* [llength] */ 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; } @@ -13075,13 +13380,6 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * 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? ?-stride len? ?-index val? list value"); - return JIM_ERR; - } - for (i = 1; i < argc - 2; i++) { int option; @@ -13112,7 +13410,7 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * break; case OPT_COMMAND: if (i >= argc - 2) { - goto wrongargs; + return JIM_USAGE; } commandObj = argv[++i]; /* fallthru */ @@ -13122,13 +13420,13 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * break; case OPT_INDEX: if (i >= argc - 2) { - goto wrongargs; + return JIM_USAGE; } indexObj = argv[++i]; break; case OPT_STRIDE: if (i >= argc - 2) { - goto wrongargs; + return JIM_USAGE; } if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) { return JIM_ERR; @@ -13143,7 +13441,7 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * argc -= i; if (argc < 2) { - goto wrongargs; + return JIM_USAGE; } argv += i; @@ -13286,28 +13584,19 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * 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) { /* Create the list if it does not exist */ 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); @@ -13320,10 +13609,6 @@ static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * 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); @@ -13351,10 +13636,6 @@ static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const 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; @@ -13394,11 +13675,7 @@ static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const /* [lset] */ static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc < 3) { - Jim_WrongNumArgs(interp, 1, argv, "listVar ?index ...? value"); - return JIM_ERR; - } - else if (argc == 3) { + if (argc == 3) { /* With no indexes, simply implements [set] */ if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK) return JIM_ERR; @@ -13413,11 +13690,11 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg { static const char * const options[] = { "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", - "-stride", NULL + "-stride", "-dictionary", NULL }; enum { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE, - OPT_STRIDE + OPT_STRIDE, OPT_DICT }; Jim_Obj *resObj; int i; @@ -13429,12 +13706,6 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg 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.indexc = 0; @@ -13452,6 +13723,9 @@ wrongargs: case OPT_ASCII: info.type = JIM_LSORT_ASCII; break; + case OPT_DICT: + info.type = JIM_LSORT_DICT; + break; case OPT_NOCASE: info.type = JIM_LSORT_NOCASE; break; @@ -13481,7 +13755,7 @@ wrongargs: break; case OPT_STRIDE: if (i >= argc - 2) { - goto wrongargs; + return JIM_USAGE; } if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) { return JIM_ERR; @@ -13559,34 +13833,24 @@ static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a 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) { /* Create the string if it doesn't exist */ 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; } } @@ -13642,11 +13906,11 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar JIM_DEF_SUBCMD("exprlen", "expression", 1, 1), JIM_DEF_SUBCMD("invstr", "object", 1, 1), JIM_DEF_SUBCMD("objcount", NULL, 0, 0), - JIM_DEF_SUBCMD("objects", NULL, 0, 0), + JIM_DEF_SUBCMD("objects", "?-taint?", 0, 1), JIM_DEF_SUBCMD("refcount", "object", 1, 1), JIM_DEF_SUBCMD("scriptlen", "script", 1, 1), JIM_DEF_SUBCMD("show", "object", 1, 1), - { /* null terminator */ } + { NULL } }; const jim_subcmd_type *ct = Jim_ParseSubCmd(interp, cmds, argc, argv); @@ -13688,14 +13952,30 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar case OPT_OBJECTS:{ Jim_Obj *objPtr, *listObjPtr, *subListObjPtr; + int tainted = 0; - /* Count the number of live objects. */ - objPtr = interp->liveList; +#ifdef JIM_TAINT + if (argc == 3) { + if (Jim_CompareStringImmediate(interp, argv[2], "-taint")) { + tainted = 1; + } + else { + Jim_SubCmdArgError(interp, ct, argv[0]); + return JIM_ERR; + } + } +#endif + + /* Return a list of the objects */ listObjPtr = Jim_NewListObj(interp, NULL, 0); - while (objPtr) { + for (objPtr = interp->liveList; objPtr; objPtr = objPtr->nextObjPtr) { char buf[128]; const char *type = objPtr->typePtr ? objPtr->typePtr->name : ""; + if (objPtr == listObjPtr || (tainted && !objPtr->taint)) { + continue; + } + subListObjPtr = Jim_NewListObj(interp, NULL, 0); sprintf(buf, "%p", objPtr); Jim_ListAppendElement(interp, subListObjPtr, Jim_NewStringObj(interp, buf, -1)); @@ -13703,7 +13983,6 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar Jim_ListAppendElement(interp, subListObjPtr, Jim_NewIntObj(interp, objPtr->refCount)); Jim_ListAppendElement(interp, subListObjPtr, objPtr); Jim_ListAppendElement(interp, listObjPtr, subListObjPtr); - objPtr = objPtr->nextObjPtr; } Jim_SetResult(interp, listObjPtr); return JIM_OK; @@ -13732,9 +14011,9 @@ static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar charlen = len; #endif char buf[256]; - snprintf(buf, sizeof(buf), "refcount: %d, type: %s\n" + snprintf(buf, sizeof(buf), "refcount: %d, taint: %d, type: %s\n" "chars (%d):", - argv[2]->refCount, JimObjTypeName(argv[2]), charlen); + argv[2]->refCount, argv[2]->taint, 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); @@ -13781,11 +14060,6 @@ static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg { int rc; - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?"); - return JIM_ERR; - } - if (argc == 2) { rc = Jim_EvalObj(interp, argv[1]); } @@ -13799,84 +14073,62 @@ static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg /* [uplevel] */ 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; + int retcode; + Jim_CallFrame *savedCallFrame, *targetCallFrame; + const char *str; - /* Save the old callframe pointer */ - savedCallFrame = interp->framePtr; + /* Save the old callframe pointer */ + savedCallFrame = interp->framePtr; - /* Lookup the target frame pointer */ - 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; - } - /* Eval the code in the target callframe. */ - 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; + /* Lookup the target frame pointer */ + str = Jim_String(argv[1]); + if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') { + targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]); + argc--; + argv++; } else { - Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?"); + targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL); + } + if (targetCallFrame == NULL) { return JIM_ERR; } + if (argc < 2) { + return JIM_USAGE; + } + /* Eval the code in the target callframe. */ + 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; } /* [expr] */ static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - int retcode; - - 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) { +#ifdef JIM_COMPAT + if (argc > 2) { + int retcode; 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; + + return retcode; } #endif - return retcode; + return Jim_EvalExpression(interp, argv[1]); } static int JimBreakContinueHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int retcode) { - if (argc != 1 && argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "?level?"); - return JIM_ERR; - } if (argc == 2) { long level; int ret = Jim_GetLong(interp, argv[1], &level); @@ -13964,8 +14216,7 @@ static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a } if (i != argc - 1 && i != argc) { - Jim_WrongNumArgs(interp, 1, argv, - "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?"); + return JIM_USAGE; } /* If a stack trace is supplied and code is error, set the stack trace */ @@ -14039,18 +14290,12 @@ static void JimAliasCmdDelete(Jim_Interp *interp, void *privData) static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - Jim_Obj *prefixListObj; - - if (argc < 3) { - Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?"); - return JIM_ERR; - } - - prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2); + Jim_Obj *prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2); Jim_IncrRefCount(prefixListObj); Jim_SetResult(interp, argv[1]); - return Jim_CreateCommandObj(interp, argv[1], JimAliasCmd, prefixListObj, JimAliasCmdDelete); + Jim_RegisterCommand(interp, argv[1], JimAliasCmd, JimAliasCmdDelete, NULL, NULL, 0, -1, JIM_CMD_ISALIAS, prefixListObj); + return JIM_OK; } /* [proc] */ @@ -14058,11 +14303,6 @@ static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg { Jim_Cmd *cmd; - if (argc != 4 && argc != 5) { - Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body"); - return JIM_ERR; - } - if (argc == 4) { cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL); } @@ -14089,11 +14329,6 @@ static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg /* [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; @@ -14112,11 +14347,6 @@ static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar { int retcode; - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?"); - return JIM_ERR; - } - /* Evaluate the arguments with 'local' in force */ interp->local++; retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1); @@ -14132,7 +14362,7 @@ static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar } if (interp->framePtr->localCommands == NULL) { interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands)); - Jim_InitStack(interp->framePtr->localCommands); + Jim_StackInit(interp->framePtr->localCommands, NULL); } Jim_IncrRefCount(cmdNameObj); Jim_StackPush(interp->framePtr->localCommands, cmdNameObj); @@ -14144,85 +14374,128 @@ static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar /* [upcall] */ static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?"); + int retcode; + + Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG); + if (cmdPtr == NULL || !(cmdPtr->flags & JIM_CMD_ISPROC) || !cmdPtr->prevCmd) { + Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]); 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; - } - /* OK. Mark this command as being in an upcall */ - cmdPtr->u.proc.upcall++; - JimIncrCmdRefCount(cmdPtr); + /* OK. Mark this command as being in an upcall */ + cmdPtr->u.proc.upcall++; + JimIncrCmdRefCount(cmdPtr); - /* Invoke the command as normal */ - retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1); + /* Invoke the command as normal */ + retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1); - /* No longer in an upcall */ - cmdPtr->u.proc.upcall--; - JimDecrCmdRefCount(interp, cmdPtr); + /* No longer in an upcall */ + cmdPtr->u.proc.upcall--; + JimDecrCmdRefCount(interp, cmdPtr); - return retcode; - } + return retcode; } /* [apply] */ static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?"); + 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; } - 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) { + if (len == 3) { #ifdef jim_ext_namespace - /* Note that the namespace is always treated as global */ - nsObj = 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; + 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); + } + argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0); + bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1); - cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj); + cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj); - if (cmd) { - /* Create a new argv array with a dummy argv[0], for error messages */ - 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; + if (cmd) { + /* Create a new argv array with a dummy argv[0], for error messages */ + 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; +} + +#ifdef JIM_TAINT +static int JimTaintVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int taint) +{ + Jim_Obj *valueObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_ERRMSG | JIM_UNSHARED); + + if (valueObjPtr == NULL) { + return JIM_ERR; + } + + if (Jim_IsShared(valueObjPtr)) { + valueObjPtr = Jim_DuplicateObj(interp, valueObjPtr); + Jim_SetVariable(interp, nameObjPtr, valueObjPtr); + } + + /* If this is an array element or a list, need to invalidate the string rep to + * force recalc. When it is regenerated, the whole string will be tainted if any component is. + */ + if (taint && nameObjPtr->typePtr == &dictSubstObjType) { + /* Tainting an array element taints the array too */ + Jim_Obj *objPtr = Jim_GetVariable(interp, nameObjPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE); + if (objPtr) { + SetStringFromAny(interp, valueObjPtr); + valueObjPtr->taint = taint; + objPtr->taint |= taint; } + } + + /* Manually tainting destroys any non-string rep */ + SetStringFromAny(interp, valueObjPtr); + valueObjPtr->taint = taint; + + //printf("taint of %s is %d\n", valueObjPtr->bytes, valueObjPtr->taint); + return JIM_OK; +} + +/* [taint] */ +static int Jim_TaintCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "varname"); return JIM_ERR; } + return JimTaintVariable(interp, argv[1], 1); } +/* [untaint] */ +static int Jim_UntaintCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "varname"); + return JIM_ERR; + } + return JimTaintVariable(interp, argv[1], 0); +} +#endif /* [concat] */ static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) @@ -14252,8 +14525,7 @@ static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar /* Check for arity */ if (argc < 3) { - Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?"); - return JIM_ERR; + return JIM_USAGE; } /* Now... for every other/local couple: */ @@ -14269,10 +14541,6 @@ static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a { int i; - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?"); - return JIM_ERR; - } /* Link every var to the toplevel having the same name */ if (interp->framePtr->level == 0) return JIM_OK; /* global at toplevel... */ @@ -14389,7 +14657,7 @@ static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a static const jim_subcmd_type cmds[OPT_COUNT + 1] = { JIM_DEF_SUBCMD("bytelength", "string", 1, 1), JIM_DEF_SUBCMD("byterange", "string first last", 3, 3), - JIM_DEF_SUBCMD("cat", "?...?", 0, -1), + JIM_DEF_SUBCMD("cat", "?string ...?", 0, -1), JIM_DEF_SUBCMD("compare", "?-nocase? ?-length int? string1 string2", 2, 5), JIM_DEF_SUBCMD("equal", "?-nocase? ?-length int? string1 string2", 2, 5), JIM_DEF_SUBCMD("first", "subString string ?index?", 2, 3), @@ -14409,7 +14677,7 @@ static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a JIM_DEF_SUBCMD("trim", "string ?trimchars?", 1, 2), JIM_DEF_SUBCMD("trimleft", "string ?trimchars?", 1, 2), JIM_DEF_SUBCMD("trimright", "string ?trimchars?", 1, 2), - { /* null terminator */ } + { NULL } }; const jim_subcmd_type *ct = Jim_ParseSubCmd(interp, cmds, argc, argv); if (!ct) { @@ -14707,10 +14975,6 @@ static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg long i, count = 1; jim_wide start, elapsed; - 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; @@ -14739,7 +15003,7 @@ static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg } /* [timerate] */ -static int Jim_TimeRateCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +static int Jim_TimerateCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { long us = 0; jim_wide start, delta, overhead; @@ -14748,10 +15012,6 @@ static int Jim_TimeRateCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const int count; int n; - if (argc < 2) { - Jim_WrongNumArgs(interp, 1, argv, "script ?milliseconds?"); - return JIM_ERR; - } if (argc == 3) { if (Jim_GetLong(interp, argv[2], &us) != JIM_OK) return JIM_ERR; @@ -14808,10 +15068,6 @@ static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg { 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; @@ -14840,10 +15096,6 @@ static int JimMatchReturnCodes(Jim_Interp *interp, Jim_Obj *retcodeListObj, int /* 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|trap codes vars script? ... ?finally script?" - }; int exitCode = 0; int i; int sig = 0; @@ -14896,7 +15148,7 @@ static int JimCatchTryHelper(Jim_Interp *interp, int istry, int argc, Jim_Obj *c option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize); } if (option < 0) { - goto wrongargs; + return JIM_USAGE; } if (ignore) { @@ -14910,9 +15162,7 @@ static int JimCatchTryHelper(Jim_Interp *interp, int istry, int argc, Jim_Obj *c idx = i; if (argc - idx < 1) { -wrongargs: - Jim_WrongNumArgs(interp, 1, argv, wrongargs_catchtry[istry]); - return JIM_ERR; + return JIM_USAGE; } if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) { @@ -14927,7 +15177,7 @@ wrongargs: else { exitCode = Jim_EvalObj(interp, argv[idx]); /* Once caught, a new error will set a stack trace again */ - interp->errorFlag = 0; + interp->hasErrorStackTrace = 0; } interp->signal_level -= sig; @@ -14955,26 +15205,32 @@ wrongargs: case TRY_ON: case TRY_TRAP: if (idx + 4 > argc) { - goto wrongargs; + return JIM_USAGE; } if (option == TRY_ON) { ret = JimMatchReturnCodes(interp, argv[idx + 1], exitCode); if (ret > JIM_OK) { - goto wrongargs; + return JIM_USAGE; } } else if (errorCodeObj) { int len = Jim_ListLength(interp, argv[idx + 1]); - int i; - - ret = JIM_OK; - /* Try to match the sublist against errorcode */ - for (i = 0; i < len; i++) { - Jim_Obj *matchObj = Jim_ListGetIndex(interp, argv[idx + 1], i); - Jim_Obj *objPtr = Jim_ListGetIndex(interp, errorCodeObj, i); - if (Jim_StringCompareObj(interp, matchObj, objPtr, 0) != 0) { - ret = -1; - break; + + if (len > Jim_ListLength(interp, errorCodeObj)) { + /* More elements in the sublist than in the errorCode so we can't match */ + ret = -1; + } + else { + int i; + ret = JIM_OK; + /* Try to match the sublist against errorcode */ + for (i = 0; i < len; i++) { + Jim_Obj *matchObj = Jim_ListGetIndex(interp, argv[idx + 1], i); + Jim_Obj *objPtr = Jim_ListGetIndex(interp, errorCodeObj, i); + if (Jim_StringCompareObj(interp, matchObj, objPtr, 0) != 0) { + ret = -1; + break; + } } } } @@ -14992,7 +15248,7 @@ wrongargs: break; case TRY_FINALLY: if (idx + 2 != argc) { - goto wrongargs; + return JIM_USAGE; } finallyScriptObj = argv[idx + 1]; idx += 2; @@ -15101,10 +15357,6 @@ static int Jim_TryCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv /* [ref] */ static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc != 3 && argc != 4) { - Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?"); - return JIM_ERR; - } if (argc == 3) { Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL)); } @@ -15119,10 +15371,6 @@ static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a { Jim_Reference *refPtr; - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "reference"); - return JIM_ERR; - } if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL) return JIM_ERR; Jim_SetResult(interp, refPtr->objPtr); @@ -15134,10 +15382,6 @@ static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a { Jim_Reference *refPtr; - if (argc != 3) { - Jim_WrongNumArgs(interp, 1, argv, "reference newValue"); - return JIM_ERR; - } if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL) return JIM_ERR; Jim_IncrRefCount(argv[2]); @@ -15150,10 +15394,6 @@ static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a /* [collect] */ static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc != 1) { - Jim_WrongNumArgs(interp, 1, argv, ""); - return JIM_ERR; - } Jim_SetResultInt(interp, Jim_Collect(interp)); /* Free all the freed objects. */ @@ -15169,10 +15409,6 @@ static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * /* [finalize] reference ?newValue? */ static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - if (argc != 2 && argc != 3) { - Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?"); - return JIM_ERR; - } if (argc == 2) { Jim_Obj *cmdNamePtr; @@ -15215,11 +15451,6 @@ static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv) /* [rename] */ 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; - } - return Jim_RenameCommand(interp, argv[1], argv[2]); } @@ -15441,7 +15672,7 @@ static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg JIM_DEF_SUBCMD("for", "vars dictionary script", 3, 3), JIM_DEF_SUBCMD("replace", "dictionary ?key value ...?", 1, -1), JIM_DEF_SUBCMD("update", "varName ?arg ...? script", 2, -1), - { /* null terminator */ } + { NULL } }; const jim_subcmd_type *ct = Jim_ParseSubCmd(interp, cmds, argc, argv); if (!ct) { @@ -15479,7 +15710,7 @@ static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg } case OPT_SET: - return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG); + return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG | JIM_UNSHARED); case OPT_EXISTS:{ int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_NONE); @@ -15491,7 +15722,7 @@ static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg } case OPT_UNSET: - if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, JIM_NONE) != JIM_OK) { + if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, JIM_UNSHARED) != JIM_OK) { return JIM_ERR; } return JIM_OK; @@ -15554,10 +15785,6 @@ static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar 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; @@ -15584,6 +15811,18 @@ static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar return JIM_OK; } +/* [lsubst] */ +static int Jim_LsubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc == 3) { + if (Jim_CompareStringImmediate(interp, argv[1], "-line")) { + return JimListSubstObj(interp, argv[2], JIM_LSUBST_LINE); + } + return JIM_USAGE; + } + return JimListSubstObj(interp, argv[1], 0); +} + #ifdef jim_ext_namespace static int JimIsGlobalNamespace(Jim_Obj *objPtr) { @@ -15597,11 +15836,12 @@ static int JimIsGlobalNamespace(Jim_Obj *objPtr) static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { Jim_Obj *objPtr; - int mode = 0; + int mode = 1; /* Must be kept in order with the array below */ enum { INFO_ALIAS, + INFO_ALIASES, INFO_ARGS, INFO_BODY, INFO_CHANNELS, @@ -15610,6 +15850,7 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg INFO_EXISTS, INFO_FRAME, INFO_GLOBALS, + INFO_HELP, INFO_HOSTNAME, INFO_LEVEL, INFO_LOCALS, @@ -15622,35 +15863,41 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg INFO_SOURCE, INFO_STACKTRACE, INFO_STATICS, + INFO_TAINTED, + INFO_USAGE, INFO_VARS, INFO_VERSION, INFO_COUNT }; static const jim_subcmd_type cmds[INFO_COUNT + 1] = { JIM_DEF_SUBCMD("alias", "command", 1, 1), + JIM_DEF_SUBCMD("aliases", "?-all? ?pattern?", 0, 2), JIM_DEF_SUBCMD("args", "procname", 1, 1), JIM_DEF_SUBCMD("body", "procname", 1, 1), - JIM_DEF_SUBCMD("channels", "?pattern?", 0, 1), - JIM_DEF_SUBCMD("commands", "?pattern?", 0, 1), + JIM_DEF_SUBCMD("channels", "?-all? ?pattern?", 0, 2), + JIM_DEF_SUBCMD("commands", "?-all? ?pattern?", 0, 2), JIM_DEF_SUBCMD("complete", "script ?missing?", 1, 2), JIM_DEF_SUBCMD("exists", "varName", 1, 1), JIM_DEF_SUBCMD("frame", "?levelNum?", 0, 1), JIM_DEF_SUBCMD("globals", "?pattern?", 0, 1), + JIM_DEF_SUBCMD("help", "command", 1, 1), JIM_DEF_SUBCMD("hostname", NULL, 0, 0), JIM_DEF_SUBCMD("level", "?levelNum?", 0, 1), JIM_DEF_SUBCMD("locals", "?pattern?", 0, 1), JIM_DEF_SUBCMD("nameofexecutable", NULL, 0, 0), JIM_DEF_SUBCMD("patchlevel", NULL, 0, 0), - JIM_DEF_SUBCMD("procs", "?pattern?", 0, 1), + JIM_DEF_SUBCMD("procs", "?-all? ?pattern?", 0, 2), JIM_DEF_SUBCMD("references", NULL, 0, 0), JIM_DEF_SUBCMD("returncodes", "?code?", 0, 1), JIM_DEF_SUBCMD("script", "?filename?", 0, 1), JIM_DEF_SUBCMD("source", "source ?filename line?", 1, 3), JIM_DEF_SUBCMD("stacktrace", NULL, 0, 0), JIM_DEF_SUBCMD("statics", "procname", 1, 1), + JIM_DEF_SUBCMD("tainted", "value", 1, 1), + JIM_DEF_SUBCMD("usage", "command", 1, 1), JIM_DEF_SUBCMD("vars", "?pattern?", 0, 1), JIM_DEF_SUBCMD("version", NULL, 0, 0), - { /* null terminator */ } + { NULL } }; const jim_subcmd_type *ct; #ifdef jim_ext_namespace @@ -15685,7 +15932,7 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) { return JIM_ERR; } - if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) { + if ((cmdPtr->flags & JIM_CMD_ISALIAS) == 0) { Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]); return JIM_ERR; } @@ -15693,36 +15940,57 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg return JIM_OK; } + case INFO_TAINTED: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "value"); + return JIM_ERR; + } + Jim_SetResultBool(interp, argv[2]->taint != 0); + return JIM_OK; case INFO_CHANNELS: - mode++; /* JIM_CMDLIST_CHANNELS */ + mode <<= 1; /* JIM_CMDLIST_CHANNELS */ #ifndef jim_ext_aio Jim_SetResultString(interp, "aio not enabled", -1); return JIM_ERR; #endif /* fall through */ + case INFO_ALIASES: + mode <<= 1; /* JIM_CMDLIST_ALIASES */ + /* fall through */ case INFO_PROCS: - mode++; /* JIM_CMDLIST_PROCS */ + mode <<= 1; /* JIM_CMDLIST_PROCS */ /* fall through */ - case INFO_COMMANDS: - /* mode 0 => JIM_CMDLIST_COMMANDS */ + case INFO_COMMANDS:{ + int n = 0; + /* mode = 1 => JIM_CMDLIST_COMMANDS */ + if (argc > 2 && Jim_CompareStringImmediate(interp, argv[2], "-all")) { + mode |= JIM_CMDLIST_ALL; + n++; + } + if (argc < 2 + n || argc > 3 + n) { + Jim_SetResultFormatted(interp, "wrong # args: should be \"info %#s %s\"", argv[1], cmds[option].args); + return JIM_ERR; + } #ifdef jim_ext_namespace if (!nons) { + /* Called as 'info -nons commands|procs' so respect the current namespace */ if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) { return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1); } } #endif - Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode)); + Jim_SetResult(interp, JimCommandsList(interp, (argc == 3 + n) ? argv[2 + n] : NULL, mode)); return JIM_OK; + } case INFO_VARS: - mode++; /* JIM_VARLIST_VARS */ + mode <<= 1; /* JIM_VARLIST_VARS */ /* fall through */ case INFO_LOCALS: - mode++; /* JIM_VARLIST_LOCALS */ + mode <<= 1; /* JIM_VARLIST_LOCALS */ /* fall through */ case INFO_GLOBALS: - /* mode 0 => JIM_VARLIST_GLOBALS */ + /* mode = 1 => JIM_VARLIST_GLOBALS */ #ifdef jim_ext_namespace if (!nons) { if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimIsGlobalNamespace(argv[2]))) { @@ -15743,7 +16011,6 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg return JIM_OK; case INFO_SOURCE:{ - jim_wide line; Jim_Obj *resObjPtr; Jim_Obj *fileNameObj; @@ -15752,26 +16019,16 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg return JIM_ERR; } if (argc == 5) { + jim_wide line; 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); + Jim_SetSourceInfo(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; - } + int line; + fileNameObj = Jim_GetSourceInfo(interp, argv[2], &line); resObjPtr = Jim_NewListObj(interp, NULL, 0); Jim_ListAppendElement(interp, resObjPtr, fileNameObj); Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line)); @@ -15808,6 +16065,27 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg } return JIM_OK; + case INFO_USAGE: + case INFO_HELP:{ + Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG); + if (!cmdPtr) { + return JIM_ERR; + } + if (option == INFO_USAGE) { + Jim_SetResult(interp, JimCmdUsage(interp, argv[2], cmdPtr)); + return JIM_OK; + } + else if ((cmdPtr->flags & JIM_CMD_ISPROC) == 0) { + if (cmdPtr->u.native.help) { + Jim_SetResultString(interp, cmdPtr->u.native.help, -1); + return JIM_OK; + } + } + /* This isn't an error */ + Jim_SetResultFormatted(interp, "No help available for command \"%#s\"", argv[2]); + return JIM_OK; + } + case INFO_BODY: case INFO_STATICS: case INFO_ARGS:{ @@ -15816,7 +16094,7 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) { return JIM_ERR; } - if (!cmdPtr->isproc) { + if ((cmdPtr->flags & JIM_CMD_ISPROC) == 0) { Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]); return JIM_ERR; } @@ -15843,12 +16121,17 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg return JIM_OK; } - case INFO_VERSION: - case INFO_PATCHLEVEL:{ - char buf[(JIM_INTEGER_SPACE * 2) + 1]; + case INFO_PATCHLEVEL: + /* bootstrap jimsh doesn't have this so fall through */ +#ifdef JIM_GITVERSION + Jim_SetResultString(interp, JIM_GITVERSION, -1); + return JIM_OK; +#endif - sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100); - Jim_SetResultString(interp, buf, -1); + case INFO_VERSION:{ + char versionbuf[64]; + snprintf(versionbuf, sizeof(versionbuf), "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100); + Jim_SetResultString(interp, versionbuf, -1); return JIM_OK; } @@ -15918,11 +16201,11 @@ static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a int result = 0; static const char * const options[] = { - "-command", "-proc", "-alias", "-var", NULL + "-command", "-proc", "-alias", "-channel", "-var", NULL }; enum { - OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR + OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_CHANNEL, OPT_VAR }; int option; @@ -15937,8 +16220,7 @@ static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a objPtr = argv[2]; } else { - Jim_WrongNumArgs(interp, 1, argv, "?option? name"); - return JIM_ERR; + return JIM_USAGE; } if (option == OPT_VAR) { @@ -15955,11 +16237,15 @@ static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a break; case OPT_ALIAS: - result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd; + result = (cmd->flags & JIM_CMD_ISALIAS) != 0; break; case OPT_PROC: - result = cmd->isproc; + result = (cmd->flags & JIM_CMD_ISPROC) != 0; + break; + + case OPT_CHANNEL: + result = (cmd->flags & JIM_CMD_ISCHANNEL) != 0; break; } } @@ -15977,11 +16263,6 @@ static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar 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; @@ -16063,10 +16344,6 @@ static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg const char *joinStr; int joinStrLen; - if (argc != 2 && argc != 3) { - Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?"); - return JIM_ERR; - } /* Init */ if (argc == 2) { joinStr = " "; @@ -16084,10 +16361,6 @@ static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a { 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; @@ -16101,10 +16374,6 @@ static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg 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) { @@ -16174,10 +16443,6 @@ static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg /* [error] */ 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]); @@ -16191,10 +16456,6 @@ static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *a { 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); @@ -16208,8 +16469,7 @@ static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * jim_wide count; if (argc < 2 || Jim_GetWideExpr(interp, argv[1], &count) != JIM_OK || count < 0) { - Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?"); - return JIM_ERR; + return JIM_USAGE; } if (count == 0 || argc == 2) { Jim_SetEmptyResult(interp); @@ -16233,11 +16493,12 @@ char **Jim_GetEnviron(void) { #if defined(HAVE__NSGETENVIRON) return *_NSGetEnviron(); +#elif defined(_environ) + return _environ; #else #if !defined(NO_ENVIRON_EXTERN) extern char **environ; #endif - return environ; #endif } @@ -16246,6 +16507,8 @@ void Jim_SetEnviron(char **env) { #if defined(HAVE__NSGETENVIRON) *_NSGetEnviron() = env; +#elif defined(_environ) + _environ = env; #else #if !defined(NO_ENVIRON_EXTERN) extern char **environ; @@ -16281,10 +16544,6 @@ static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv return JIM_OK; } - if (argc > 3) { - Jim_WrongNumArgs(interp, 1, argv, "varName ?default?"); - return JIM_ERR; - } key = Jim_String(argv[1]); val = getenv(key); if (val == NULL) { @@ -16301,16 +16560,9 @@ static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv /* [source] */ static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - int retval; + int retval = Jim_EvalFile(interp, Jim_String(argv[1])); - 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; + return retval == JIM_RETURN ? JIM_OK : retval; } /* [lreverse] */ @@ -16319,10 +16571,6 @@ static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const Jim_Obj *revObjPtr, **ele; int len; - if (argc != 2) { - Jim_WrongNumArgs(interp, 1, argv, "list"); - return JIM_ERR; - } JimListGetElements(interp, argv[1], &len, &ele); revObjPtr = Jim_NewListObj(interp, NULL, 0); ListEnsureLength(revObjPtr, len); @@ -16366,10 +16614,6 @@ static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *ar 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_GetWideExpr(interp, argv[1], &end) != JIM_OK) return JIM_ERR; @@ -16398,10 +16642,6 @@ static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg { 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) { @@ -16429,97 +16669,110 @@ static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg } } -static const struct { +static const struct jim_core_cmd_def_t { const char *name; Jim_CmdProc *cmdProc; + short minargs; + short maxargs; + const char *usage; + int flags; } 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}, + {"*", Jim_MulCoreCommand, 0, -1, "?number ...?" }, + {"+", Jim_AddCoreCommand, 0, -1, "?number ...?" }, + {"-", Jim_SubCoreCommand, 1, -1, "number ?number ...?" }, + {"/", Jim_DivCoreCommand, 1, -1, "number ?number ...?" }, + {"alias", Jim_AliasCoreCommand, 2, -1, "newname command ?args ...?" }, + {"append", Jim_AppendCoreCommand, 1, -1, "varName ?value ...?" }, + {"apply", Jim_ApplyCoreCommand, 1, -1, "lambdaExpr ?arg ...?" }, + {"break", Jim_BreakCoreCommand, 0, 1, "?level?" }, + {"catch", Jim_CatchCoreCommand, 1, -1, "?-?no?code ... --? script ?resultVarName? ?optionVarName?" }, + {"concat", Jim_ConcatCoreCommand, 0, -1, "?arg ...?" }, + {"continue", Jim_ContinueCoreCommand, 0, 1, "?level?" }, #if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP) - {"debug", Jim_DebugCoreCommand}, + {"debug", Jim_DebugCoreCommand, 1, -1, "subcommand ?arg ...?" }, #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}, - {"global", Jim_GlobalCoreCommand}, - {"string", Jim_StringCoreCommand}, - {"time", Jim_TimeCoreCommand}, - {"timerate", Jim_TimeRateCoreCommand}, - {"exit", Jim_ExitCoreCommand}, - {"catch", Jim_CatchCoreCommand}, - {"try", Jim_TryCoreCommand}, + {"dict", Jim_DictCoreCommand, 1, -1, "subcommand ?arg ...?"}, + {"env", Jim_EnvCoreCommand, 0, 2, "?varName? ?default?" }, + {"error", Jim_ErrorCoreCommand, 1, 2, "message ?stacktrace?" }, + {"eval", Jim_EvalCoreCommand, 1, -1, "arg ?arg ...?" }, + {"exists", Jim_ExistsCoreCommand, 1, 2, "?-command|-proc|-alias|-channel|-var? name" }, + {"exit", Jim_ExitCoreCommand, 0, 1, "?exitCode?" }, +#ifdef JIM_COMPAT + {"expr", Jim_ExprCoreCommand, 1, -1, "expression ?...?" }, +#else + {"expr", Jim_ExprCoreCommand, 1, 1, "expression" }, +#endif + {"for", Jim_ForCoreCommand, 4, 4, "start test next body" }, + {"foreach", Jim_ForeachCoreCommand, 3, -1, "varList list ?varList list ...? script" }, + {"format", Jim_FormatCoreCommand, 1, -1, "formatString ?arg arg ...?" }, + {"global", Jim_GlobalCoreCommand, 1, -1, "varName ?varName ...?" }, + {"if", Jim_IfCoreCommand, 2, -1, "condition ?then? trueBody ?elseif ...? ?else? ?falseBody?" }, + {"incr", Jim_IncrCoreCommand, 1, 2, "varName ?increment?" }, + {"info", Jim_InfoCoreCommand, 1, -1, "subcommand ?arg ...?"}, + {"join", Jim_JoinCoreCommand, 1, 2, "list ?joinString?" }, + {"lappend", Jim_LappendCoreCommand, 1, -1, "varName ?value value ...?" }, + {"lassign", Jim_LassignCoreCommand, 2, -1, "varList list ?varName ...?" }, + {"lindex", Jim_LindexCoreCommand, 1, -1, "list ?index ...?" }, + {"linsert", Jim_LinsertCoreCommand, 2, -1, "list index ?element ...?" }, + {"list", Jim_ListCoreCommand, 0, -1, "?arg ...?" }, + {"llength", Jim_LlengthCoreCommand, 1, 1, "list" }, + {"lmap", Jim_LmapCoreCommand, 3, -1, "varList list ?varList list ...? script" }, + {"local", Jim_LocalCoreCommand, 1, -1, "cmd ?args ...?" }, + {"loop", Jim_LoopCoreCommand, 3, 5, "var ?first? limit ?incr? body" }, + {"lrange", Jim_LrangeCoreCommand, 3, 3, "list first last" }, + {"lrepeat", Jim_LrepeatCoreCommand, 1, -1, "count ?value ...?" }, + {"lreplace", Jim_LreplaceCoreCommand, 3, -1, "list first last ?element ...?" }, + {"lreverse", Jim_LreverseCoreCommand, 1, 1, "list" }, + {"lsearch", Jim_LsearchCoreCommand, 2, -1, "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? ?-stride len? ?-index val? list value" }, + {"lset", Jim_LsetCoreCommand, 2, -1, "listVar ?index ...? value" }, + {"lsort", Jim_LsortCoreCommand, 1, -1, "?options? list" }, + {"lsubst", Jim_LsubstCoreCommand, 1, 2, "?-line? string" }, + {"proc", Jim_ProcCoreCommand, 3, 4, "name arglist ?statics? body" }, + {"puts", Jim_PutsCoreCommand, 1, 2, "?-nonewline? string" }, + {"rand", Jim_RandCoreCommand, 0, 2, "?min? ?max?" }, + {"range", Jim_RangeCoreCommand, 1, 3, "?start? end ?step?" }, + {"rename", Jim_RenameCoreCommand, 2, 2, "oldName newName" }, + {"return", Jim_ReturnCoreCommand, 0, -1, "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?" }, + {"scan", Jim_ScanCoreCommand, 2, -1, "string format ?varName varName ...?" }, + {"set", Jim_SetCoreCommand, 1, 2, "varName ?newValue?" }, + {"source", Jim_SourceCoreCommand, 1, 1, "fileName", JIM_CMD_NOTAINT }, + {"split", Jim_SplitCoreCommand, 1, 2, "string ?splitChars?" }, + {"stacktrace", Jim_StacktraceCoreCommand, 0, 2, "?firstlevel? ?lastlevel?" }, + {"string", Jim_StringCoreCommand, 1, -1, "subcommand ?arg ...?" }, + {"subst", Jim_SubstCoreCommand, 1, 4, "?options? string" }, + {"switch", Jim_SwitchCoreCommand, 2, -1, "?options? string pattern body ... ?default body? or pattern body ?pattern body ...?" }, + {"tailcall", Jim_TailcallCoreCommand, 0, -1, "?cmd arg ...?" }, + {"time", Jim_TimeCoreCommand, 1, 2, "script ?count?" }, + {"timerate", Jim_TimerateCoreCommand, 1, 2, "script ?milliseconds?" }, + {"try", Jim_TryCoreCommand, 1, -1, "?-?no?code ... --? script ?on|trap codes vars script? ... ?finally script?" }, + {"unset", Jim_UnsetCoreCommand, 0, -1, "?-nocomplain? ?--? ?varName ...?"}, + {"upcall", Jim_UpcallCoreCommand, 1, -1, "cmd ?args ...?" }, + {"uplevel", Jim_UplevelCoreCommand, 1, -1, "?level? command ?arg ...?" }, + {"upvar", Jim_UpvarCoreCommand, 2, -1, "?level? otherVar myVar ?otherVar myVar ...?"}, + {"while", Jim_WhileCoreCommand, 2, 2, "condition body" }, + {"xtrace", Jim_XtraceCoreCommand, 1, 1, "callback" }, #ifdef JIM_REFERENCES - {"ref", Jim_RefCoreCommand}, - {"getref", Jim_GetrefCoreCommand}, - {"setref", Jim_SetrefCoreCommand}, - {"finalize", Jim_FinalizeCoreCommand}, - {"collect", Jim_CollectCoreCommand}, + {"collect", Jim_CollectCoreCommand, 0, 0, "" }, + {"finalize", Jim_FinalizeCoreCommand, 1, 2, "reference ?finalizerProc?" }, + {"getref", Jim_GetrefCoreCommand, 1, 1, "reference" }, + {"ref", Jim_RefCoreCommand, 2, 3, "string tag ?finalizer?" }, + {"setref", Jim_SetrefCoreCommand, 2, 2, "reference newValue" }, +#endif +#ifdef JIM_TAINT + {"taint", Jim_TaintCoreCommand, 1, 1, "varname"}, + {"untaint", Jim_UntaintCoreCommand, 1, 1, "varname"}, #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}, - {"stacktrace", Jim_StacktraceCoreCommand}, {NULL, NULL}, }; void Jim_RegisterCoreCommands(Jim_Interp *interp) { - int i = 0; + const struct jim_core_cmd_def_t *c; - while (Jim_CoreCommandsTable[i].name != NULL) { - Jim_CreateCommand(interp, - Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL); - i++; + for (c = Jim_CoreCommandsTable; c->name; c++) { + /* All core commands must have usage */ + assert(c->usage); + Jim_RegisterCmd(interp, c->name, c->usage, c->minargs, c->maxargs, c->cmdProc, NULL, NULL, c->flags); } } @@ -125,8 +125,9 @@ extern "C" { * ---------------------------------------------------------------------------*/ /* Increment this every time the public ABI changes */ -#define JIM_ABI_VERSION 101 +#define JIM_ABI_VERSION 102 +/* Tcl return codes */ #define JIM_OK 0 #define JIM_ERR 1 #define JIM_RETURN 2 @@ -134,6 +135,8 @@ extern "C" { #define JIM_CONTINUE 4 #define JIM_SIGNAL 5 #define JIM_EXIT 6 +/* Special meaning */ +#define JIM_USAGE -1 /* Throw a usage error */ /* The following are internal codes and should never been seen/used */ #define JIM_EVAL 7 /* tailcall */ @@ -150,7 +153,6 @@ extern "C" { #define JIM_NONE 0 /* no flags set */ #define JIM_ERRMSG 1 /* set an error message in the interpreter. */ -#define JIM_ENUM_ABBREV 2 /* Jim_GetEnum() - Allow unambiguous abbreviation */ #define JIM_UNSHARED 4 /* Jim_GetVariable() - return unshared object */ #define JIM_MUSTEXIST 8 /* Jim_SetDictKeysVector() - fail if non-existent */ #define JIM_NORESULT 16 /* Jim_SetDictKeysVector() - don't store the result in the interp result */ @@ -161,6 +163,14 @@ extern "C" { #define JIM_SUBST_NOESC 4 /* don't perform escapes substitutions */ #define JIM_SUBST_FLAG 128 /* flag to indicate that this is a real substitution object */ +#define JIM_TAINT_STD 1 /* The "normal" type of taint. Allows for multiple + * types of taint in the future + */ +#define JIM_TAINT_ANY ~0 /* Any type of taint at all */ + +/* Flags for Jim_GetEnum() */ +#define JIM_ENUM_ABBREV 2 /* Allow unambiguous abbreviation */ + /* Flags used by API calls getting a 'nocase' argument. */ #define JIM_CASESENS 0 /* case sensitive */ #define JIM_NOCASE 1 /* no case */ @@ -183,6 +193,7 @@ typedef struct Jim_Stack { int len; int maxlen; void **vector; + void (*freefunc) (void *ptr); } Jim_Stack; /* ----------------------------------------------------------------------------- @@ -285,6 +296,7 @@ typedef struct Jim_Obj { const struct Jim_ObjType *typePtr; /* object type. */ int refCount; /* reference count */ int length; /* number of bytes in 'bytes', not including the null term. */ + unsigned taint; /* If this object is tainted */ /* Internal representation union */ union { /* integer number type */ @@ -439,8 +451,6 @@ typedef struct Jim_CallFrame { Jim_Obj *procBodyObjPtr; /* body object of the running procedure */ struct Jim_CallFrame *next; /* Callframes are in a linked list */ Jim_Obj *nsObj; /* Namespace for this proc call frame */ - Jim_Obj *unused_fileNameObj; - int unused_line; Jim_Stack *localCommands; /* commands to be destroyed when the call frame is destroyed */ struct Jim_Obj *tailcallObj; /* Pending tailcall invocation */ struct Jim_Cmd *tailcallCmd; /* Resolved command for pending tailcall invocation */ @@ -494,12 +504,21 @@ typedef struct Jim_Dict { unsigned int dummy; /* Number of dummy entries */ } Jim_Dict; +#define JIM_CMD_ISPROC 1 +#define JIM_CMD_ISCHANNEL 2 +#define JIM_CMD_ISALIAS 4 + +/* When a command is registered with this flag, it can't be called with + * tainted data + */ +#define JIM_CMD_NOTAINT 0x100 + /* A command is implemented in C if isproc is 0, otherwise * it is a Tcl procedure with the arglist and body represented by the * two objects referenced by arglistObjPtr and bodyObjPtr. */ typedef struct Jim_Cmd { int inUse; /* Reference count */ - int isproc; /* Is this a procedure? */ + int flags; /* JIM_CMD_XXX */ struct Jim_Cmd *prevCmd; /* Previous command defn if cmd created 'local' */ Jim_Obj *cmdNameObj; /* The fully resolved command name - just a pointer, not a reference */ union { @@ -508,6 +527,10 @@ typedef struct Jim_Cmd { Jim_CmdProc *cmdProc; /* The command implementation */ Jim_DelCmdProc *delProc; /* Called when the command is deleted if != NULL */ void *privData; /* command-private data available via Jim_CmdPrivData() */ + const char *usage; /* If not NULL, usage text - used by 'info usage' */ + const char *help; /* If not NULL, help text - used by 'info help' */ + short minargs; + short maxargs; /* -1 for unlimited */ } native; struct { /* Tcl procedure */ @@ -540,7 +563,6 @@ typedef struct Jim_PrngState { * ---------------------------------------------------------------------------*/ typedef struct Jim_Interp { Jim_Obj *result; /* object returned by the last command called. */ - int unused_errorLine; /* Error line where an error occurred. */ Jim_Obj *currentFilenameObj; /* filename of current Jim_EvalFile() */ int break_level; /* break/continue level */ int maxCallFrameDepth; /* Used for infinite loop detection. */ @@ -568,11 +590,9 @@ typedef struct Jim_Interp { 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 *unused_currentScriptObj; /* Script currently in execution. */ Jim_EvalFrame topEvalFrame; /* dummy top evaluation frame */ Jim_EvalFrame *evalFrame; /* evaluation stack */ int procLevel; - Jim_Obj * const *unused_argv; Jim_Obj *nullScriptObj; /* script representation of an empty string */ Jim_Obj *emptyObj; /* Shared empty string object. */ Jim_Obj *trueObj; /* Shared true int object. */ @@ -591,7 +611,7 @@ typedef struct Jim_Interp { 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. */ + int hasErrorStackTrace; /* If a stack trace has been set due to an error 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(). */ @@ -603,6 +623,7 @@ typedef struct Jim_Interp { Jim_PrngState *prngState; /* per interpreter Random Number Gen. state. */ struct Jim_HashTable packages; /* Provided packages hash table */ Jim_Stack *loadHandles; /* handles of loaded modules [load] */ + unsigned taint; /* Newly created objects get this taint */ } Jim_Interp; /* Currently provided as macro that performs the increment. @@ -699,14 +720,19 @@ JIM_EXPORT int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj JIM_EXPORT int Jim_SubstObj (Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags); +/* source information */ +JIM_EXPORT Jim_Obj *Jim_GetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, + int *lineptr); +/* may only be called on an unshared object */ +JIM_EXPORT void Jim_SetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *fileNameObj, int lineNumber); + + /* stack */ -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_StackInit(Jim_Stack *stack, void (*freefunc) (void *ptr)); +JIM_EXPORT void Jim_StackFree(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 void *Jim_StackPop(Jim_Stack *stack); /* hash table */ JIM_EXPORT int Jim_InitHashTable (Jim_HashTable *ht, @@ -783,16 +809,36 @@ JIM_EXPORT const char *Jim_ReturnCode(int code); JIM_EXPORT void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...); /* commands */ -JIM_EXPORT void Jim_RegisterCoreCommands (Jim_Interp *interp); +JIM_EXPORT Jim_Cmd *Jim_RegisterCommand(Jim_Interp *interp, Jim_Obj *cmdNameObj, + Jim_CmdProc *cmdProc, + Jim_DelCmdProc *delProc, + const char *usage, + const char *help, + short minargs, + short maxargs, + int flags, + void *privData); +/* This is a this wrapper around Jim_RegisterCommand */ JIM_EXPORT int Jim_CreateCommand (Jim_Interp *interp, const char *cmdName, Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc); +/* Simplify creating commands that specify minargs, maxargs and usage but + * don't need delProc or privData + */ +#define Jim_RegisterSimpleCmd(interp, name, usage, minargs, maxargs, cmdproc) \ + Jim_RegisterCommand(interp, Jim_NewStringObj(interp, name, -1), cmdproc, NULL, usage, NULL, minargs, maxargs, 0, NULL) +/* And also slightly more complex where delProc, privData and flags may be needed */ +#define Jim_RegisterCmd(interp, name, usage, minargs, maxargs, cmdproc, delproc, privdata, flags) \ + Jim_RegisterCommand(interp, Jim_NewStringObj(interp, name, -1), cmdproc, delproc, usage, NULL, minargs, maxargs, flags, privdata) + +JIM_EXPORT void Jim_RegisterCoreCommands (Jim_Interp *interp); JIM_EXPORT int Jim_DeleteCommand (Jim_Interp *interp, Jim_Obj *cmdNameObj); JIM_EXPORT int Jim_RenameCommand (Jim_Interp *interp, Jim_Obj *oldNameObj, Jim_Obj *newNameObj); JIM_EXPORT Jim_Cmd * Jim_GetCommand (Jim_Interp *interp, Jim_Obj *objPtr, int flags); +/* Note that if Jim_SetVariable() fails, and valObjPtr has a zero reference count, it will be freed */ JIM_EXPORT int Jim_SetVariable (Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr); JIM_EXPORT int Jim_SetVariableStr (Jim_Interp *interp, @@ -982,6 +1028,22 @@ JIM_EXPORT int Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *command); JIM_EXPORT int Jim_IsDict(Jim_Obj *objPtr); JIM_EXPORT int Jim_IsList(Jim_Obj *objPtr); +/* taint */ +JIM_EXPORT void Jim_SetTaintError(Jim_Interp *interp, int cmdargs, Jim_Obj *const *argv); +JIM_EXPORT int Jim_CalcTaint(int argc, Jim_Obj *const *argv); + +#ifdef JIM_TAINT +#define Jim_CheckTaint(i, t) ((i)->taint & (t)) +#define Jim_TaintObj(o,t) (o)->taint |= (t) +#define Jim_UntaintObj(o) (o)->taint = 0 +#define Jim_GetObjTaint(o) (o)->taint +#else +#define Jim_CheckTaint(i, t) 0 +#define Jim_TaintObj(o,t) +#define Jim_UntaintObj(o) +#define Jim_GetObjTaint(o) 0 +#endif + #ifdef __cplusplus } #endif diff --git a/jim_tcl.txt b/jim_tcl.txt index 9cfa6f8..adf68a1 100644 --- a/jim_tcl.txt +++ b/jim_tcl.txt @@ -3,7 +3,7 @@ Jim Tcl(n) NAME ---- -Jim Tcl v0.82+ - reference manual for the Jim Tcl scripting language +Jim Tcl v0.83+ - reference manual for the Jim Tcl scripting language SYNOPSIS -------- @@ -33,128 +33,145 @@ available only in Jim Tcl. 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 -3. Integers are 64bit -4. Support for references (`ref`/`getref`/`setref`) and garbage collection -5. Builtin dictionary type (`dict`) with some limitations compared to Tcl 8.6 -6. `env` command to access environment variables -7. Operating system features: `os.fork`, `os.uptime`, `wait`, `signal`, `alarm`, `sleep` -8. Much better error reporting. `info stacktrace` as a replacement for '$errorInfo', '$errorCode' -9. Support for "static" variables in procedures -10. Threads and coroutines are not supported -11. Command and variable traces are not supported -12. Built-in command line editing -13. Expression shorthand syntax: +$(...)+ -14. Modular build allows many features to be omitted or built as dynamic, loadable modules -15. Highly suitable for use in an embedded environment -16. Support for UDP, IPv6, Unix-Domain sockets in addition to TCP sockets +#. Object-based I/O (aio), but with a Tcl-compatibility layer +#. I/O: Support for sockets and pipes including TCP, UDP, UNIX-Domain sockets and IPv6 +#. Integers are 64bit +#. Support for references (`ref`/`getref`/`setref`) and garbage collection +#. Builtin dictionary type (`dict`) with some limitations compared to Tcl 8.6 +#. `env` command to access environment variables +#. Operating system features: `os.fork`, `os.uptime`, `wait`, `signal`, `alarm`, `sleep` +#. Much better error reporting. `info stacktrace` as a replacement for '$errorInfo', '$errorCode' +#. Support for "static" variables in procedures +#. Threads and coroutines are not supported +#. Command and variable traces are not supported +#. Built-in command line editing in interactive mode with autocompletion and hints +#. Expression shorthand syntax: +$(...)+ +#. Modular build allows many features to be omitted or built as dynamic, loadable modules +#. Highly suitable for use in an embedded environment +#. Jim does not convert backslash-newline within braces (in order to preserve accurate line numbers) RECENT CHANGES -------------- -Changes since 0.82 +Changes since 0.83 ~~~~~~~~~~~~~~~~~~ -1. Multi-level `break` and `continue` are now supported -2. `info frame` now only returns 'proc' levels -3. `stacktrace` is now a builtin command -4. The stack trace on error now includes the full stack trace, not just back to where it was caught -5. Improvements with `aio`, related to eventloop and buffering. Add `aio timeout`. -6. `socket` , `open` and `aio accept` now support '-noclose' -7. Add support for hinting with `history hints` -8. Support for `proc` statics by reference (lexical closure) rather than by value -9. `regsub` now supports '-command' (per Tcl 8.7) +#. `aio` - support for configurable read and write buffering +#. Add support for `package forget` +#. Add `aio translation` support (and fconfigure -translation) +#. `exec` TIP 424 - support safer +'exec |'+ syntax (also +'open "|| pipeline..."'+) +#. New `lsubst` command to create lists using subst-style substitution +#. Add support for `regexp -expanded` and `regsub -expanded` +#. `vwait` now accepts a script argument +#. Add support for `os.umask` +#. Add `taint` support for improved data security +#. Improved API for creating C commands with +'Jim_RegisterCommand'+ for arg checking and usage +#. New `info usage` to return the usage for a proc or native command +#. New `info aliases` to list all aliases +#. `expr` supports new +'=*'+ and +'=~'+ matching operators (see <<_expressions,EXPRESSIONS>>) + +Changes between 0.82 and 0.83 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +#. Multi-level `break` and `continue` are now supported +#. `info frame` now only returns 'proc' levels +#. `stacktrace` is now a builtin command +#. The stack trace on error now includes the full stack trace, not just back to where it was caught +#. Improvements with `aio`, related to eventloop and buffering. Add `aio timeout`. +#. `socket` , `open` and `aio accept` now support '-noclose' +#. Add support for hinting with `history hints` +#. Support for `proc` statics by reference (lexical closure) rather than by value +#. `regsub` now supports '-command' (per Tcl 8.7) +#. Add support for `lsort -dict` Changes between 0.81 and 0.82 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. `try` now supports trap to match on errorcode -2. TIP 603, `aio stat` is now supported to stat a file handle -3. Add support for `socket -async` -4. The handles created by `socket pty` now make the replica name available via 'filename' -5. `info frame` now returns a (largely) Tcl-compatible dictionary, and supports 'info frame 0' -6. `vwait -signal` is now supported -7. ./configure now defaults to '--full' -8. New `timerate` command as an improvement over `time`, somewhat compatible with TIP 527 -9. Add `ensemble` command and support for `namespace ensemble` (as an optional extension) +#. `try` now supports trap to match on errorcode +#. TIP 603, `aio stat` is now supported to stat a file handle +#. Add support for `socket -async` +#. The handles created by `socket pty` now make the replica name available via 'filename' +#. `info frame` now returns a (largely) Tcl-compatible dictionary, and supports 'info frame 0' +#. `vwait -signal` is now supported +#. ./configure now defaults to '--full' +#. New `timerate` command as an improvement over `time`, somewhat compatible with TIP 527 +#. Add `ensemble` command and support for `namespace ensemble` (as an optional extension) 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: +#. TIP 582, comments allowed in expressions +#. 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) +#. String and list indexes now accept integer expressions (<<_string_and_list_index_specifications,STRING AND LIST INDEX SPECIFICATIONS>>) +#. `loop` can now omit the start value +#. Add the `xtrace` command for execution trace support +#. Add `history keep` +#. Add support for `lsearch -index` and `lsearch -stride`, the latter per TIP 351 +#. `lsort -index` now supports multiple indices +#. Add support for `lsort -stride` +#. `open` now supports POSIX-style access arguments +#. 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 +#. `regsub` now fully supports +{backslash}A+ +#. Add `socket pty` to create a pseudo-tty pair +#. Null characters (\x00) are now supported in variable and proc names +#. dictionaries and arrays now preserve insertion order, matching Tcl and the documentation +#. Add `dict getwithdefault` (and the alias `dict getdef`) per TIP 342 +#. Add string comparison operators (lt, gt, le, ge) per TIP 461 +#. 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 -2. `aio` now supports datagram Unix-Domain sockets -3. Add support for `aio lock -wait` -4. Add `signal block` to prevent delivery of signals -5. Add support for `file split` -6. Add support for `json::encode` and `json::decode` -7. `aio tty` now allows setting +echo+ without full +raw+ mode +#. Add `file mtimeus` for high resolution file timestamps +#. `aio` now supports datagram Unix-Domain sockets +#. Add support for `aio lock -wait` +#. Add `signal block` to prevent delivery of signals +#. Add support for `file split` +#. Add support for `json::encode` and `json::decode` +#. `aio tty` now allows setting +echo+ without full +raw+ mode Changes between 0.77 and 0.78 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. Add serial/tty support with `aio tty` -2. Add support for 'jimsh -' -3. Add hidden '-commands' option to many commands -4. Add scriptable autocompletion support in interactive mode with `tcl::autocomplete` -5. Add `aio sockopt` -6. Add scriptable autocompletion support with `history completion` -7. Add support for `tree delete` -8. Add support for `defer` and '$jim::defer' -9. Renamed `os.wait` to `wait`, now more Tcl-compatible and compatible with `exec ... &` -10. `pipe` is now a synonym for `socket pipe` -11. Closing a pipe open with `open |...` now returns Tcl-like status -12. It is now possible to used `exec` redirection with a pipe opened with `open |...` -13. Interactive line editing now supports multiline mode if $::history::multiline is set +#. Add serial/tty support with `aio tty` +#. Add support for 'jimsh -' +#. Add hidden '-commands' option to many commands +#. Add scriptable autocompletion support in interactive mode with `tcl::autocomplete` +#. Add `aio sockopt` +#. Add scriptable autocompletion support with `history completion` +#. Add support for `tree delete` +#. Add support for `defer` and '$jim::defer' +#. Renamed `os.wait` to `wait`, now more Tcl-compatible and compatible with `exec ... &` +#. `pipe` is now a synonym for `socket pipe` +#. Closing a pipe open with `open |...` now returns Tcl-like status +#. It is now possible to used `exec` redirection with a pipe opened with `open |...` +#. Interactive line editing now supports multiline mode if $::history::multiline is set Changes between 0.76 and 0.77 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. Add support for `aio sync` -2. Add SSL and TLS support in aio -3. Added `zlib` -4. Added support for boolean constants in `expr` -5. `string is` now supports 'boolean' class -6. Add support for `aio lock` and `aio unlock` -7. Add new `interp` command +#. Add support for `aio sync` +#. Add SSL and TLS support in aio +#. Added `zlib` +#. Added support for boolean constants in `expr` +#. `string is` now supports 'boolean' class +#. Add support for `aio lock` and `aio unlock` +#. Add new `interp` command Changes between 0.75 and 0.76 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. `glob` now supports the +-tails+ option -2. Add support for `string cat` -3. Allow `info source` to add source info +#. `glob` now supports the +-tails+ option +#. Add support for `string cat` +#. Allow `info source` to add source info Changes between 0.74 and 0.75 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. `binary`, `pack` and `unpack` now support floating point -2. `file copy` +-force+ handles source and target as the same file -3. `format` now supports +%b+ for binary conversion -4. `lsort` now supports +-unique+ and +-real+ -5. Add support for half-close with `aio close` +?r|w?+ -6. Add `socket pair` for a bidirectional pipe -7. Add '--random-hash' to randomise hash tables for greater security -8. `dict` now supports 'for', 'values', 'incr', 'append', 'lappend', 'update', 'info' and 'replace' -9. `file stat` no longer requires the variable name -10. Add support for `file link` +#. `binary`, `pack` and `unpack` now support floating point +#. `file copy` +-force+ handles source and target as the same file +#. `format` now supports +%b+ for binary conversion +#. `lsort` now supports +-unique+ and +-real+ +#. Add support for half-close with `aio close` +?r|w?+ +#. Add `socket pair` for a bidirectional pipe +#. Add '--random-hash' to randomise hash tables for greater security +#. `dict` now supports 'for', 'values', 'incr', 'append', 'lappend', 'update', 'info' and 'replace' +#. `file stat` no longer requires the variable name +#. Add support for `file link` TCL INTRODUCTION ----------------- @@ -316,7 +333,7 @@ has three fields: the first, `set`, is the name of a Tcl command, and the last two, 'a' and '22', will be passed as arguments to the `set` command. The command name may refer either to a built-in Tcl command, an application-specific command bound in with the library -procedure 'Jim_CreateCommand', or a command procedure defined with the +procedure 'Jim_RegisterCommand', or a command procedure defined with the `proc` built-in command. Arguments are passed literally as text strings. Individual commands may @@ -590,41 +607,12 @@ sequence is replaced by the given character: +{backslash}v+:: Vertical tab (0xb). -+{backslash}{+:: - Left brace ({). - -+{backslash}}+:: - Right brace (}). - -+{backslash}[+:: - Open bracket ([). - -+{backslash}]+:: - Close bracket (]). - -+{backslash}$+:: - Dollar sign ($). - -+{backslash}<space>+:: - Space ( ): doesn't terminate argument. - -+{backslash};+:: - Semi-colon: doesn't terminate command. - -+{backslash}"+:: - Double-quote. - -+{backslash}<newline>+:: - Nothing: this joins two lines together - into a single line. This backslash feature is unique in that - it will be applied even when the sequence occurs within braces. - -+{backslash}{backslash}+:: - Backslash ('{backslash}'). - +{backslash}ddd+:: The digits +'ddd'+ (one, two, or three of them) give the octal value of - the character. Note that Jim supports null characters in strings. + the byte. Note that Jim supports null characters in strings. + ++{backslash}xnn+:: + The hexidecimal digits +'nn'+ give the value of the byte. +{backslash}unnnn+:: +{backslash}u\{nnn\}+:: @@ -633,32 +621,24 @@ sequence is replaced by the given character: The 'u' form allows for one to four hex digits. The 'U' form allows for one to eight hex digits. The 'u\{nnn\}' form allows for one to eight hex digits, but makes it easier to insert - characters UTF-8 characters which are followed by a hex digit. - -For example, in the command - ----- - set a \{x\[\ yz\141 ----- - -the second argument to `set` will be +{x[ yza+. + UTF-8 characters that are followed by a hex digit. If a backslash is followed by something other than one of the options -described above, then the backslash is transmitted to the argument -field without any special processing, and the Tcl scanner continues +described above, the backslash is skipped and character following the backslash is treated +as a normal character without any special meaning. The Tcl scanner continues normal processing with the next character. For example, in the command +For example, in the command + ---- - set \*a \\{foo + set a \\{x\[\ yz\141 ---- -The first argument to `set` will be +*a+ and the second -argument will be +{foo+. +the second argument to `set` will be +{x[ yza+. If an argument is enclosed in braces, then backslash sequences inside -the argument are parsed but no substitution occurs (except for -backslash-newline): the backslash +the argument are parsed but no substitution occurs: the backslash sequence is passed through to the argument as is, without making any special interpretation of the characters in the backslash sequence. In particular, backslashed braces are not counted in locating the @@ -903,6 +883,14 @@ of precedence: String equal and not equal. Uses the string value directly without attempting to convert to a number first. ++=*+:: + String glob match. The left and side is the string to match and the right + and side is the pattern. See <<_string_matching,STRING MATCHING>>. + ++=~+:: + String regexp match. The left and side is the string to match and the right + and side is the regular expression. See <<_regular_expressions,REGULAR EXPRESSIONS>>. + +in ni+:: String in list and not in list. For 'in', result is 1 if the left operand (as a string) is contained in the right operand (as a list), or 0 otherwise. The result for @@ -1233,6 +1221,10 @@ defined in jim.h, and are: Indicates that the command called the `exit` command. The string contains the exit code. ++JIM_USAGE(-1)+:: + This is a special return code that is automatically translated into JIM_ERR with the command usage + (from Jim_RegisterCommand()) as the message. + Tcl programmers do not normally need to think about return codes, since +JIM_OK+ is almost always returned. If anything else is returned by a command, then the Tcl interpreter immediately stops processing @@ -2091,7 +2083,7 @@ curry Similar to `alias` except it creates an anonymous procedure (lambda) instead of a named procedure. -the following creates a local, unnamed alias for the command `info exists`. +The following creates a local, unnamed alias for the command `info exists`. ---- set e [local curry info exists] @@ -2130,6 +2122,11 @@ Performs one of several operations on dictionary values. The +'option'+ argument determines what action is carried out by the command. The legal +'options'+ are: ++*dict append* 'dictionaryName key ?string ...?'+:: + This appends the given string (or strings) to the value that + the given key maps to in +'dictionaryName'+. Non-existent keys + are treated as if they map to an empty string. + +*dict create* '?key value \...?'+:: Create and return a new dictionary value that contains each of the key/value mappings listed as arguments (keys and values @@ -2142,6 +2139,9 @@ command. The legal +'options'+ are: dictionary value. This returns a true value exactly when `dict get` on that path will succeed. ++*dict for* '{keyvar valuevar} dictionary script'+:: + *TBD* + +*dict get* 'dictionary ?key \...?'+:: Given a dictionary value (first argument) and a key (second argument), this will retrieve the value for that key. Where several keys are @@ -2162,12 +2162,28 @@ command. The legal +'options'+ are: Similar to `dict get` except if no value exists in the dictionary for the give key(s), returns +'default'+ instead. ++*dict incr* 'dictionaryName key ?increment?'+:: + This adds the given increment value (an integer that defaults + to 1 if not specified) to the value that the given key maps to + in +'dictionaryName'+. Non-existent keys are treated as if + they map to 0. It is an error to increment a value for an + existing key if that value is not an integer. + ++*dict info* 'dictionary'+:: + Returns some information about the utilisation of the data + within the hashtable that represents +'dictionary'+. + +*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 <<_string_matching,STRING MATCHING>> rules) are included. ++*dict lappend* 'dictionaryName key ?value ...?'+:: + This appends the given items to the list value that the given + key maps to in +'dictionaryName'+. Non-existent keys are treated + as if they map to the empty list. + +*dict merge* ?'dictionary \...'?+:: Return a dictionary that contains the contents of each of the +'dictionary'+ arguments. Where two (or more) dictionaries @@ -2175,6 +2191,13 @@ command. The legal +'options'+ are: maps that key to the value according to the last dictionary on the command line containing a mapping for that key. ++*dict replace* 'dictionary ?key value ...?'+:: + Return a new dictionary that is a copy of +'dictionary'+ + except with some values different or some + extra key/value pairs added. It is legal for this command to + be called with no key/value pairs, but illegal for this command + to be called with a key but no value. + +*dict set* 'dictionaryName key ?key \...? value'+:: This operation takes the +'name'+ of a variable containing a dictionary value and places an updated dictionary value in that variable @@ -2194,6 +2217,16 @@ command. The legal +'options'+ are: least one key must be specified, but the last key on the key-path need not exist. All other components on the path must exist. ++*dict update* 'dictionaryName key varName ?key VarName ...? script'+:: + *TBD* + ++*dict values* 'dictionary ?globPattern?'+:: + Return a list of all values in +'dictionary'+. If a pattern is + supplied, only those values that match it (according to the + rules of `string match`) will be returned. The returned values + will be in the order of that the keys associated with those + values were inserted into the dictionary. + +*dict with* 'dictionaryName key ?key \...? script'+:: Execute the Tcl script in +'script'+ with the value for each key in +'dictionaryName'+ mapped to a variable with the same @@ -2213,8 +2246,6 @@ command. The legal +'options'+ are: explicitly unset). Note that changes to the contents of +'dictionaryName'+ only happen when +'script'+ terminates. -+*dict for, values, incr, append, lappend, update, info, replace*+ to be documented... - ensemble ~~~~~~~~ +*ensemble* 'name ?*-automap*? prefix'+ @@ -2224,15 +2255,15 @@ By default, the prefix is +'name'+ followed by a single space. For example, consider: +---- proc {test open} {name} { ... } proc {test close} {handle} { ... } proc {test show} {handle} { ... } ensemble test +---- Now the '+test+' command has been created that redirects based on the first argument. -e.g. - - test open $filename => {test open} $filename +e.g. +'test open $filename'+ => +'{test open} $filename'+ env ~~~ @@ -2311,6 +2342,8 @@ exec ~~~~ +*exec* 'arg ?arg\...?'+ ++*exec* | '{cmdlist \...} ?redirection \...?'+ + This command treats its arguments as the specification of one or more UNIX commands to execute as subprocesses. The commands take the form of a standard shell pipeline; @@ -2344,7 +2377,8 @@ is a newline then that character is deleted from the result or error message for consistency with normal Tcl return values. -An +'arg'+ may have one of the following special forms: +An +'arg'+ (or +'redirection'+ in the second form) may have one of the +following special forms: +>filename+:: The standard output of the last command in the pipeline @@ -2361,23 +2395,23 @@ An +'arg'+ may have one of the following special forms: will normally return an empty string. +2>filename+:: - The standard error of the last command in the pipeline + The standard error of all commands in the pipeline is redirected to the file. +2>>filename+:: As above, but append to the file. +2>@fileId+:: - The standard error of the last command in the pipeline is + The standard error of all commands in the pipeline is redirected to the given (writable) file descriptor. +2>@1+:: - The standard error of the last command in the pipeline is - redirected to the same file descriptor as the standard output. + The standard error of all commands in the pipeline is + redirected command output. +>&filename+:: - Both the standard output and standard error of the last command - in the pipeline is redirected to the file. + Both standard output from the last command and standard error from all commands + in the pipeline are redirected to the file. +>>&filename+:: As above, but append to the file. @@ -2394,24 +2428,29 @@ An +'arg'+ may have one of the following special forms: The standard input of the first command in the pipeline is taken from the given (readable) file descriptor. +Note that any of the forms that take an argument (filename, fileId or string) +their argument may be a separate word. e.g. +'<< $str'+. + If there is no redirection of standard input, standard error or standard output, these are connected to the corresponding input or output of the application. -If the last +'arg'+ is +&+ then the command will be -executed in background. -In this case the standard output from the last command -in the pipeline will -go to the application's standard output unless -redirected in the command, and error output from all -the commands in the pipeline will go to the application's -standard error file. The return value of exec in this case -is a list of process ids (pids) in the pipeline. +If the last +'arg'+ or +'redirection'+ is +&+ then the command will be +executed in background. In this case the standard output from the last +command in the pipeline will go to the application's standard output +unless redirected in the command, and error output from all the commands +in the pipeline will go to the application's standard error file. The +return value of exec in this case is a list of process ids (pids) in +the pipeline. Each +'arg'+ becomes one word for a command, except for +|+, +<+, +<<+, +>+, and +&+ arguments, and the arguments that follow +<+, +<<+, and +>+. +In the second form, +'cmdlist'+ is the command list, so there +is no ambiguity about whether an argument or a redirection. +Note that this second form is not currently supported by Tcl. + The first word in each command is taken as the command name; the directories in the PATH environment variable are searched for an executable by the given name. @@ -2453,12 +2492,12 @@ this variable is unset, in which case the original environment is used). exists ~~~~~~ -+*exists ?-var|-proc|-command|-alias?* 'name'+ ++*exists ?-var|-proc|-command|-alias|-channel?* 'name'+ -Checks the existence of the given variable, procedure, command -or alias respectively and returns 1 if it exists or 0 if not. This command +Checks the existence of the given variable, procedure, command, +alias or channel respectively and returns 1 if it exists or 0 if not. This command provides a more simplified/convenient version of `info exists`, -`info procs` and `info commands`. +`info procs`, `info commands`, `info aliases` and `info channels`. If the type is omitted, a type of '-var' is used. The type may be abbreviated. @@ -2899,19 +2938,27 @@ The legal +'option'+'s (which may be abbreviated) are: +'command'+ must be an alias created with `alias`. In which case the target command and arguments, as passed to `alias` are returned. See `exists -alias` ++*info aliases ?-all?* ?'pattern'?+:: + Returns a list of alias commands. + See `info commands` for the meaning of +*-all*+ and +'pattern'+. + +*info body* 'procname'+:: Returns the body of procedure +'procname'+. +'procname'+ must be the name of a Tcl command procedure. -+*info channels*+:: - Returns a list of all open file handles from `open` or `socket` ++*info channels ?-all?* ?'pattern'?+:: + Returns a list of open file handles from `open` or `socket`. + See `info commands` for the meaning of +*-all*+ and +'pattern'+. -+*info commands* ?'pattern'?+:: ++*info commands ?-all?* ?'pattern'?+:: If +'pattern'+ isn't specified, returns a list of names of all the Tcl commands, including both the built-in commands written in C and - the command procedures defined using the `proc` command. + the command procedures defined using the `proc` command (including aliases + and channels). If +'pattern'+ is specified, only those names matching +'pattern'+ (using <<_string_matching,STRING MATCHING>> rules) are returned. + Normally commands containing a space character are not returned. + If +*-all*+ is given, the result does include these commands. +*info complete* 'command' ?'missing'?+:: Returns 1 if +'command'+ is a complete Tcl command in the sense of @@ -2987,11 +3034,13 @@ The legal +'option'+'s (which may be abbreviated) are: was invoked. A full path will be returned, unless the path can't be determined, in which case the empty string will be returned. -+*info procs* ?'pattern'?+:: - 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'+ - (using <<_string_matching,STRING MATCHING>> rules) are returned. ++*info patchlevel*+:: + Returns the build (git) version if available. Otherwise + returns the same as `info version`. + ++*info procs ?-all?* ?'pattern'?+:: + Returns a list containing the names of Tcl command procedures. + See `info commands` for the meaning of +*-all*+ and +'pattern'+. +*info references*+:: Returns a list of all references which have not yet been garbage @@ -3026,6 +3075,14 @@ The legal +'option'+'s (which may be abbreviated) are: procedure. An empty dictionary is returned if the procedure has no static variables. ++*info tainted* 'str'+:: + Returns 1 if the value is tainted, or 0 if not. + ++*info usage* 'command'+:: + Returns the usage for the given command. For Tcl command procedures, this is based + on the arguments defined for the procedure. For a C command, this is the command usage + that was specificied when the command was registered. + +*info version*+:: Returns the version number for this version of Jim in the form +*x.yy*+. @@ -3120,6 +3177,63 @@ than variables, a list of unassigned elements is returned. a=1,b=2 ---- +lsubst +~~~~ ++*lsubst ?-line?* 'string'+ + +This command is similar to `list` in that it creates a list, but uses +the same rules as scripts when constructing the elements of the list. +It is somewhat similar to `subst` except it produces a list instead of a string. + +This means that variables are substituted, commands are evaluated, backslashes are +interpreted, the expansion operator is applied and comments are skipped. + +Consider the following example. + +--- + set x 1 + set y {2 3} + set z 3 + lsubst { + # This is a list with interpolation + $x; # The x variable + {*}$y; # The y variable expanded + [string cat a b c]; # A command + {*}[list 4 5]; # A list expanded into multiple elements + "$z$z"; # A string with interpolation + } +--- + +The result of `lsubst` is the following list with 7 elements. + +--- + 1 2 3 abc 4 5 33 +--- + +This is particularly useful when constructing a list (or dict) +as a data structure as it easily allows for comments and variable and command +substitution. + +Sometimes it is useful to return each "command" as a separate list rather than +simply running all the words together. This can be accomplished with `lsubst -line`. + +Consider the following example. + +--- + lsubst -line { + # two "lines" because of the semicolon + one a; two b + # one line with three elements + {*}{a b c} + } +--- + +The result of `lsubst -line` is the following list with 3 elements, one for each "command". + +--- +{one a} {two b} {a b c} +--- + local ~~~~~ +*local* 'cmd ?arg\...?'+ @@ -3151,16 +3265,13 @@ continues to have global scope while it is active. ---- In this example, the lambda is deleted at the end of the procedure rather -than waiting until garbage collection. +than waiting until garbage collection. Note that `local` returns the command name. ---- proc outer {} { - set x [lambda inner {args} { + set x [local lambda {args} { # will be deleted when 'outer' exits }] - # Use 'function' here which simply returns $x - local function $x - $x ... ... } @@ -3495,18 +3606,29 @@ lsort 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. -Note that only one sort type may be selected with +-integer+, +-real+, +-nocase+ or +-command+ +Note that only one sort type may be selected with +-ascii+, +-dict+, +-integer+, +-real+, +-nocase+ or +-command+ with last option being used. ++*-ascii*+:: + Sort using string comparison. This is the default. + ++*-nocase*+:: + Sort using using string comparison without regard for case. + ++*-dict*+:: + Sort using using string comparison without regard for case. + Use dictionary-style comparison. This is the same as '-ascii' + except (a) case is ignored except as a tie-breaker and (b) if + two strings contain embedded numbers, the numbers compare as + integers, not characters. For example, in -dictionary mode, + x10y sorts between x9y and x11y. + +*-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 @@ -3638,6 +3760,8 @@ by the command. If read-only access is used (e.g. +'access'+ is r), standard input for the pipeline is taken from the current standard input unless overridden by the command. +Note that this incudes new style exec syntax, e.g. +'open |[list | ls -l] r'+. + The `pid` command may be used to return the process ids of the commands forming the command pipeline. @@ -3645,32 +3769,34 @@ See also `socket`, `pid`, `exec` package ~~~~~~~ -+*package provide* 'name ?version?'+ ++*package forget* '?name ...?'+:: +Removes the knowledge that the given packages were loaded. This allows new, replacement +packages to be loaded. Note that it does not remove any effects of the previous packages +being loaded. ++*package provide* 'name ?version?'+:: Indicates that the current script provides the package named +'name'+. *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. - + :: The first such file which is found is considered to provide the package. (The version number is ignored). - + :: If '$name.so' exists, it is loaded with the `load` command, 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*+ - ++*package names*+:: Returns a list of all known/loaded packages, including internal packages. pid @@ -3771,7 +3897,7 @@ Integer parameters may be any integer expression. read ~~~~ -+*read ?-nonewline? 'fileId ?length?'+ ++*read* ?-nonewline? 'fileId ?length?'+ Tcl-compatible alterative version of +'fileId' *read ?-nonewline?* '?length?'+ @@ -3779,7 +3905,7 @@ See `aio read` regexp ~~~~~~ -+*regexp ?-nocase? ?-line? ?-indices? ?-start* 'offset'? *?-all? ?-inline? ?--?* 'exp string ?matchVar? ?subMatchVar subMatchVar \...?'+ ++*regexp ?-nocase? ?-line? ?-indices? ?-start* 'offset'? *?-all? ?-inline? ?-expanded? ?--?* 'exp string ?matchVar? ?subMatchVar subMatchVar \...?'+ Determines whether the regular expression +'exp'+ matches part or all of +'string'+ and returns 1 if it does, 0 if it doesn't. @@ -3852,13 +3978,17 @@ The following switches modify the behaviour of +'regexp'+ data, plus one element for each subexpression in the regular expression. ++*-expanded*+:: + Enables use of the expanded regular expression syntax where whitespace + and comments are ignored. + +*--*+:: Marks the end of switches. The argument following this one will be treated as +'exp'+ even if it starts with a +-+. regsub ~~~~~~ -+*regsub ?-nocase? ?-all? ?-line? ?-command? ?-start* 'offset'? ?*--*? 'exp string subSpec ?varName?'+ ++*regsub ?-nocase? ?-all? ?-line? ?-command? ?-expanded? ?-start* 'offset'? ?*--*? 'exp string subSpec ?varName?'+ This command matches the regular expression +'exp'+ against +'string'+ using the rules described in REGULAR EXPRESSIONS @@ -3940,6 +4070,10 @@ The following switches modify the behaviour of +'regsub'+ start matching the regular expression. +'offset'+ will be constrained to the bounds of the input string. ++*-expanded*+:: + Enables use of the expanded regular expression syntax where whitespace + and comments are ignored. + +*--*+:: Marks the end of switches. The argument following this one will be treated as +'exp'+ even if it starts with a +-+. @@ -4430,6 +4564,9 @@ For example, if +-nocommands+ is specified, no command substitution is performed: open and close brackets are treated as ordinary characters with no special interpretation. +*Note*: `expr` shorthand +$(\...)+ is considered a variable substitution +and so is disabled by +-novariables+. + *Note*: when it performs its substitutions, subst does not give any special treatment to double quotes or curly braces. For example, the following script returns +xyz \{44\}+, not +xyz \{$a\}+. @@ -4555,6 +4692,12 @@ The following are identical except the first immediately replaces the current ca proc sub_cmd2 ... ---- +taint +~~~~~ ++*taint* 'varname'+ + +Set "taint" on the value contained in the given variable. + tell ~~~~ +*tell* 'fileId'+ @@ -4721,6 +4864,12 @@ An error occurs if any of the variables doesn't exist, unless '-nocomplain' is specified. The '--' argument may be specified to stop option processing in case the variable name may be '-nocomplain'. +untaint +~~~~~~~ ++*untaint* 'varname'+ + +Remove "taint" from the value contained in the given variable. + upcall ~~~~~~~ +*upcall* 'command ?args ...?'+ @@ -4901,8 +5050,8 @@ what options were selected when Jim Tcl was built. [[cmd_1]] -posix: os.fork, os.gethostname, os.getids, os.uptime -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +posix: os.fork, os.gethostname, os.getids, os.uptime, os.umask +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +*os.fork*+:: Invokes 'fork(2)' and returns the result. @@ -4917,6 +5066,9 @@ posix: os.fork, os.gethostname, os.getids, os.uptime uid 1000 euid 1000 gid 100 egid 100 ---- ++*os.umask* ?newmask?+:: + Set or return the current process 'umask(2)'. Returns the previous umask. + +*os.uptime*+:: Returns the number of seconds since system boot. See description of 'uptime' in 'sysinfo(2)'. @@ -4966,16 +5118,19 @@ aio If +'-noclose'+ is given, the returned handle is not automatically closed for child proceses. See `socket` for details. -+$handle *buffering none|line|full*+:: ++$handle *buffering none|line|full* ?size?+:: Sets the output buffering mode of the stream channel. +'none'+ means that puts immediately writes output. +'line'+ means output (including previously buffered output) is written if a newline is to be written. +'full'+ means that data is written when the output buffer is full - (currently approx 64KB). Note that line buffering will also write + (default 64KB). Size may be specified in full mode. + Note that line buffering will also write once the output buffer limit is reached, even if there is no newline. Channels usually begin in full buffering mode, unless they identify as a tty channel, in which case line buffering is used, and `stderr` - begins with no buffering. See also `aio puts` and `aio flush`. + begins with no buffering. Returns the current buffering mode (including + size in full mode - e.g. +'line'+ or +'full 65536+'. + See also `aio puts` and `aio flush`. +$handle *close ?r(ead)|w(rite)? ?-nodelete?*+:: Closes the stream. @@ -5063,6 +5218,12 @@ aio expected number of bytes (including zero). Use `aio eof` to determine if the end-of-file has been reached. ++$handle *readsize* ?size?'+:: + Sets or returns the current size of the read buffer used + for read, gets and copyto. + Defaults to 256, but can be increased to improve performance + for large reads. + +$handle *recvfrom* 'maxlen ?addrvar?'+:: Receives a message from the datagram channel via recvfrom(2) and returns it. At most +'maxlen'+ bytes are read. If +'addrvar'+ is specified, the sending address @@ -5125,6 +5286,15 @@ This command returns an empty string. will be returned instead. Although this is designed for normal files and those should be used in blocking mode. ++$handle *taint source|sink ?0:n?*+:: + Sets the taint characteristics of the channel. Data read from + the channel will have a taint value as set by +'source'+, while + a check will be made against data written to the channel against + the +'sink'+ value. If the taint of the data and the channel + match, the operation will fail. By default, channels created + by `open` are not tainted while channels created by `socket` + have both set to 1. + +$handle *tell*+:: Returns the current seek position or -1 if the channel is not seekable. @@ -5134,6 +5304,12 @@ This command returns an empty string. See `aio read` and `aio gets` for command that use the timeout. Note that the timeout is only used if the channel is in blocking mode. ++$handle *translation binary|text*+:: + This has no effect on Unix platforms, but on Windows it changes the mode of the file + handle to binary or text. In general, use "wb" as the open mode instead, but this + can be useful on existing filehandles such as +stdout+ and +stderr+. It is probably + a good idea to do this immediately before sending any output. + +$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 \...+. @@ -5245,7 +5421,7 @@ fconfigure command is supported. * `fconfigure ... -blocking` maps to `aio ndelay` * `fconfigure ... -buffering` maps to `aio buffering` - * `fconfigure ... -translation` is accepted but ignored + * `fconfigure ... -translation` maps to `aio translation` and suppports only +binary+ and +text+ [[cmd_2]] eventloop: after, vwait, update @@ -5295,14 +5471,16 @@ Time-based execution is also available via the eventloop API. the type of the event. An error occurs if +'id'+ does not match an event. -+*vwait ?-signal?* 'variable'+:: ++*vwait ?-signal?* 'variable' ?script?+:: A call to `vwait` enters the eventloop. `vwait` processes events until the named (global) variable changes or all event handlers are removed. The variable need not exist beforehand. If there are no event handlers defined, `vwait` - returns immediately. If +'-signal'+ is specified, `vwait` will + returns immediately. If +*-signal*+ is specified, `vwait` will also quit if a handled signal occurs. In this case, `signal check -clear` - can be used to check for the signal that occurred. + can be used to check for the signal that occurred. If +'script'+ is given + it is evaluated after each event. If it returns break, `vwait` returns. + `vwait` also returns with an error if the script returns an error. +*update ?idletasks?*+:: A call to `update` enters the eventloop to process expired events, but @@ -5746,6 +5924,11 @@ namespace ~~~~~~~~~ Provides namespace-related functions. See also: http://www.tcl.tk/man/tcl8.6/TclCmd/namespace.htm ++*namespace canonical* ?current? ?name?+:: + Returns the full name of +'name'+ within namespace '+current+'. + If '+current+' is not given, `namespace current` is used. + If neither are given, returns the current namespace (not qualified with a leading '::'). + +*namespace code* 'script'+:: Captures the current namespace context for later execution of the script +'script'+. It returns a new script in which script has @@ -5757,7 +5940,7 @@ Provides namespace-related functions. See also: http://www.tcl.tk/man/tcl8.6/Tcl +*namespace delete* '?namespace ...?'+:: Deletes all commands and variables with the given namespace prefixes. -+*namespace ensemble create*'+:: ++*namespace ensemble create*+:: Creates an ensemble command for the current namespace (requires the 'ensemble' extension'). +*namespace eval* 'namespace arg ?arg...?'+:: diff --git a/jimiocompat.c b/jimiocompat.c index 8e7f3f2..44a1387 100644 --- a/jimiocompat.c +++ b/jimiocompat.c @@ -6,7 +6,7 @@ void Jim_SetResultErrno(Jim_Interp *interp, const char *msg) Jim_SetResultFormatted(interp, "%s: %s", msg, strerror(Jim_Errno())); } -#if defined(__MINGW32__) +#if defined(_WIN32) || defined(WIN32) #include <sys/stat.h> int Jim_Errno(void) @@ -213,7 +213,9 @@ int Jim_MakeTempFile(Jim_Interp *interp, const char *filename_template, int unli } /* Update the template name directly with the filename */ +#ifdef HAVE_UMASK mask = umask(S_IXUSR | S_IRWXG | S_IRWXO); +#endif #ifdef HAVE_MKSTEMP fd = mkstemp(filenameObj->bytes); #else @@ -224,7 +226,9 @@ int Jim_MakeTempFile(Jim_Interp *interp, const char *filename_template, int unli fd = open(filenameObj->bytes, O_RDWR | O_CREAT | O_TRUNC); } #endif +#ifdef HAVE_UMASK umask(mask); +#endif if (fd < 0) { Jim_SetResultErrno(interp, Jim_String(filenameObj)); Jim_FreeNewObj(interp, filenameObj); diff --git a/jimiocompat.h b/jimiocompat.h index 0837b73..0f807a0 100644 --- a/jimiocompat.h +++ b/jimiocompat.h @@ -31,7 +31,7 @@ int Jim_OpenForWrite(const char *filename, int append); */ int Jim_OpenForRead(const char *filename); -#if defined(__MINGW32__) +#if defined(__MINGW32__) || defined(_WIN32) #ifndef STRICT #define STRICT #endif @@ -69,6 +69,12 @@ int Jim_OpenForRead(const char *filename); #define Jim_Stat _stat64 #define Jim_FileStat _fstat64 #define Jim_Lseek _lseeki64 + #define O_TEXT _O_TEXT + #define O_BINARY _O_BINARY + #define Jim_SetMode _setmode + #ifndef STDIN_FILENO + #define STDIN_FILENO 0 + #endif #else #if defined(HAVE_STAT64) @@ -111,12 +117,21 @@ int Jim_OpenForRead(const char *filename); #define execvpe(ARG0, ARGV, ENV) execvp(ARG0, ARGV) #endif #endif -#endif -#ifndef O_TEXT -#define O_TEXT 0 + #ifndef O_TEXT + #define O_TEXT 0 + #endif + #endif +# ifndef MAXPATHLEN +# ifdef PATH_MAX +# define MAXPATHLEN PATH_MAX +# else +# define MAXPATHLEN JIM_PATH_LEN +# endif +# endif + /* jim-file.c */ /* Note that this is currently an internal function only. * It does not form part of the public Jim API diff --git a/jimregexp.c b/jimregexp.c index 136b0c0..86f99ce 100644 --- a/jimregexp.c +++ b/jimregexp.c @@ -1,5 +1,5 @@ /* - * vi:se ts=8: + * vi:se ts=8 sw=8: * * regcomp and regexec -- regsub and regerror are elsewhere * @@ -164,8 +164,7 @@ */ #define FAIL(R,M) { (R)->err = (M); return (M); } -#define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?' || (c) == '{') -#define META "^$.[()|?{+*" +#define META "^$.[()|" /* * Flags to be passed up and down. @@ -203,6 +202,22 @@ static void regdump(regex_t *preg); static const char *regprop( int op ); #endif +/* Returns 1 if *s is '*', '+', '?', or {n...} where n must be a number */ +static int str_is_mult(const char *s) +{ + switch (*s) { + case '*': + case '+': + case '?': + return 1; + case '{': + if (isdigit(UCHAR(s[1]))) { + return 1; + } + break; + } + return 0; +} /** * Returns the length of the null-terminated integer sequence. @@ -216,6 +231,41 @@ static int str_int_len(const int *seq) return n; } +/* skips preg->regparse past white space and comments to end of line if REG_EXPANDED */ +static char *reg_expanded_new_pattern(const char *exp) +{ + /* Make a copy and do removal in place as the final will always be no longer than the original */ + char *newexp = strdup(exp); + char *d = newexp; + const char *s = exp; + int escape = 0; + + while (*s) { + if (escape) { + escape = 0; + continue; + } + else if (*s == '\\') { + escape = 1; + } + else if (strchr(" \t\r\n\f\v", *s)) { + s++; + continue; + } + else if (*s == '#') { + /* skip comments to end of line */ + s++; + while (*s && *s != '\n') { + s++; + } + continue; + } + *d++ = *s++; + } + *d++ = '\0'; + return newexp; +} + /* - regcomp - compile a regular expression into internal code * @@ -246,6 +296,11 @@ int jim_regcomp(regex_t *preg, const char *exp, int cflags) if (exp == NULL) FAIL(preg, REG_ERR_NULL_ARGUMENT); + if (cflags & REG_EXPANDED) { + preg->exp = reg_expanded_new_pattern(exp); + exp = preg->exp; + } + /* First pass: determine size, legality. */ preg->cflags = cflags; preg->regparse = exp; @@ -454,12 +509,12 @@ static int regpiece(regex_t *preg, int *flagp) if (ret == 0) return 0; - op = *preg->regparse; - if (!ISMULT(op)) { + if (!str_is_mult(preg->regparse)) { *flagp = flags; return(ret); } + op = *preg->regparse; if (!(flags&HASWIDTH) && op != '?') { preg->err = REG_ERR_OPERAND_COULD_BE_EMPTY; return 0; @@ -528,7 +583,7 @@ static int regpiece(regex_t *preg, int *flagp) } preg->regparse++; - if (ISMULT(*preg->regparse)) { + if (str_is_mult(preg->regparse)) { preg->err = REG_ERR_NESTED_COUNT; return 0; } @@ -876,12 +931,6 @@ cc_switch: case ')': preg->err = REG_ERR_INTERNAL; return 0; /* Supposed to be caught earlier. */ - case '?': - case '+': - case '*': - case '{': - preg->err = REG_ERR_COUNT_FOLLOWS_NOTHING; - return 0; case '\\': ch = *preg->regparse++; switch (ch) { @@ -946,6 +995,11 @@ cc_switch: /* Back up to pick up the first char of interest */ preg->regparse -= n; + if (str_is_mult(preg->regparse)) { + preg->err = REG_ERR_COUNT_FOLLOWS_NOTHING; + return 0; + } + ret = regnode(preg, EXACTLY); /* Note that a META operator such as ? or * consumes the @@ -955,7 +1009,7 @@ cc_switch: */ /* Until end of string or a META char is reached */ - while (*preg->regparse && strchr(META, *preg->regparse) == NULL) { + while (*preg->regparse && strchr(META, *preg->regparse) == NULL && !str_is_mult(preg->regparse)) { n = reg_utf8_tounicode_case(preg->regparse, &ch, (preg->cflags & REG_ICASE)); if (ch == '\\' && preg->regparse[n]) { /* Non-trailing backslash. @@ -980,7 +1034,7 @@ cc_switch: * Check to see if the following char is a MULT */ - if (ISMULT(preg->regparse[n])) { + if (str_is_mult(&preg->regparse[n])) { /* Yes. But do we already have some EXACTLY chars? */ if (added) { /* Yes, so return what we have and pick up the current char next time around */ @@ -1180,7 +1234,7 @@ int jim_regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t } if (*string) { nextline: - if (preg->cflags & REG_NEWLINE) { + if (preg->cflags & REG_NEWLINE_ANCHOR) { /* Try the next anchor? */ string = strchr(string, '\n'); if (string) { @@ -1315,12 +1369,12 @@ static const char *str_find(const char *string, int c, int nocase) /** * Returns true if 'ch' is an end-of-line char. * - * In REG_NEWLINE mode, \n is considered EOL in + * In REG_NEWLINE_STOP mode, \n is considered EOL in * addition to \0 */ static int reg_iseol(regex_t *preg, int ch) { - if (preg->cflags & REG_NEWLINE) { + if (preg->cflags & REG_NEWLINE_STOP) { return ch == '\0' || ch == '\n'; } else { @@ -1911,6 +1965,7 @@ size_t jim_regerror(int errcode, const regex_t *preg, char *errbuf, size_t errb void jim_regfree(regex_t *preg) { + free(preg->exp); free(preg->program); } diff --git a/jimregexp.h b/jimregexp.h index e18178e..b6058c7 100644 --- a/jimregexp.h +++ b/jimregexp.h @@ -49,6 +49,7 @@ typedef struct regexp { int regmust; /* Internal use only. */ int regmlen; /* Internal use only. */ int *program; /* Allocated */ + char *exp; /* NULL or allocated version of regcomp expression (for REG_EXPANDED) */ /* working state - compile */ const char *regparse; /* Input-scan pointer. */ @@ -69,10 +70,14 @@ typedef struct regexp { typedef regexp regex_t; #define REG_EXTENDED 0 -#define REG_NEWLINE 1 #define REG_ICASE 2 +#define REG_NEWLINE_ANCHOR 4 +#define REG_NEWLINE_STOP 8 +/* REG_NEWLINE is POSIX */ +#define REG_NEWLINE (REG_NEWLINE_ANCHOR | REG_NEWLINE_STOP) #define REG_NOTBOL 16 +#define REG_EXPANDED 32 enum { REG_NOERROR, /* Success. */ @@ -37,8 +37,9 @@ #include <stdlib.h> #include <string.h> -#include "jim.h" #include "jimautoconf.h" +#include "jim.h" +#include "jimiocompat.h" /* From initjimsh.tcl */ extern int Jim_initjimshInit(Jim_Interp *interp); @@ -123,6 +124,10 @@ int main(int argc, char *const argv[]) } if (retcode != JIM_EXIT) { JimSetArgv(interp, 0, NULL); + if (!isatty(STDIN_FILENO)) { + /* Just read from stdin and evaluate */ + goto eval_stdin; + } retcode = Jim_InteractivePrompt(interp); } } @@ -145,6 +150,7 @@ int main(int argc, char *const argv[]) Jim_SetVariableStr(interp, "argv0", Jim_NewStringObj(interp, argv[1], -1)); JimSetArgv(interp, argc - 2, argv + 2); if (strcmp(argv[1], "-") == 0) { +eval_stdin: retcode = Jim_Eval(interp, "eval [info source [stdin read] stdin 1]"); } else { retcode = Jim_EvalFile(interp, argv[1]); diff --git a/jsmn/jsmn.c b/jsmn/jsmn.c index 2de5ec2..2174df9 100644 --- a/jsmn/jsmn.c +++ b/jsmn/jsmn.c @@ -1,17 +1,24 @@ #include "jsmn.h" +/* For json-decode we want strict mode so we don't get + * garbage for malformed json + */ +#define JSMN_STRICT + /** * Allocates a fresh unused token from the token pool. */ static jsmntok_t *jsmn_alloc_token(jsmn_parser *parser, jsmntok_t *tokens, size_t num_tokens) { jsmntok_t *tok; + parser->count++; if (parser->toknext >= num_tokens) { return NULL; } tok = &tokens[parser->toknext++]; tok->start = tok->end = -1; tok->size = 0; + tok->line = 0; #ifdef JSMN_PARENT_LINKS tok->parent = -1; #endif @@ -22,11 +29,12 @@ static jsmntok_t *jsmn_alloc_token(jsmn_parser *parser, * Fills token type and boundaries. */ static void jsmn_fill_token(jsmntok_t *token, jsmntype_t type, - int start, int end) { + int start, int end, int line) { token->type = type; token->start = start; token->end = end; token->size = 0; + token->line = line; } /** @@ -41,11 +49,13 @@ static int jsmn_parse_primitive(jsmn_parser *parser, const char *js, for (; parser->pos < len && js[parser->pos] != '\0'; parser->pos++) { switch (js[parser->pos]) { + case '\n' : + parser->line++; + /* fall-thru */ #ifndef JSMN_STRICT - /* In strict mode primitive must be followed by "," or "}" or "]" */ case ':': #endif - case '\t' : case '\r' : case '\n' : case ' ' : + case '\t' : case '\r' : case ' ' : case ',' : case ']' : case '}' : goto found; } @@ -61,16 +71,16 @@ static int jsmn_parse_primitive(jsmn_parser *parser, const char *js, #endif found: + token = jsmn_alloc_token(parser, tokens, num_tokens); if (tokens == NULL) { parser->pos--; return 0; } - token = jsmn_alloc_token(parser, tokens, num_tokens); if (token == NULL) { parser->pos = start; return JSMN_ERROR_NOMEM; } - jsmn_fill_token(token, JSMN_PRIMITIVE, start, parser->pos); + jsmn_fill_token(token, JSMN_PRIMITIVE, start, parser->pos, parser->line); #ifdef JSMN_PARENT_LINKS token->parent = parser->toksuper; #endif @@ -95,15 +105,15 @@ static int jsmn_parse_string(jsmn_parser *parser, const char *js, /* Quote: end of string */ if (c == '\"') { + token = jsmn_alloc_token(parser, tokens, num_tokens); if (tokens == NULL) { return 0; } - token = jsmn_alloc_token(parser, tokens, num_tokens); if (token == NULL) { parser->pos = start; return JSMN_ERROR_NOMEM; } - jsmn_fill_token(token, JSMN_STRING, start+1, parser->pos); + jsmn_fill_token(token, JSMN_STRING, start+1, parser->pos, parser->line); #ifdef JSMN_PARENT_LINKS token->parent = parser->toksuper; #endif @@ -153,7 +163,6 @@ int jsmn_parse(jsmn_parser *parser, const char *js, size_t len, int r; int i; jsmntok_t *token; - int count = parser->toknext; for (; parser->pos < len && js[parser->pos] != '\0'; parser->pos++) { char c; @@ -162,11 +171,10 @@ int jsmn_parse(jsmn_parser *parser, const char *js, size_t len, c = js[parser->pos]; switch (c) { case '{': case '[': - count++; + token = jsmn_alloc_token(parser, tokens, num_tokens); if (tokens == NULL) { break; } - token = jsmn_alloc_token(parser, tokens, num_tokens); if (token == NULL) return JSMN_ERROR_NOMEM; if (parser->toksuper != -1) { @@ -235,11 +243,13 @@ int jsmn_parse(jsmn_parser *parser, const char *js, size_t len, case '\"': r = jsmn_parse_string(parser, js, len, tokens, num_tokens); if (r < 0) return r; - count++; if (parser->toksuper != -1 && tokens != NULL) tokens[parser->toksuper].size++; break; - case '\t' : case '\r' : case '\n' : case ' ': + case '\n' : + parser->line++; + /* fall-thru */ + case '\t' : case '\r' : case ' ': break; case ':': parser->toksuper = parser->toknext - 1; @@ -262,35 +272,39 @@ int jsmn_parse(jsmn_parser *parser, const char *js, size_t len, #endif } break; + + default: + /* In non-strict mode every unquoted value is a primitive */ #ifdef JSMN_STRICT - /* In strict mode primitives are: numbers and booleans */ - case '-': case '0': case '1' : case '2': case '3' : case '4': - case '5': case '6': case '7' : case '8': case '9': - case 't': case 'f': case 'n' : - /* And they must not be keys of the object */ - if (tokens != NULL && parser->toksuper != -1) { - jsmntok_t *t = &tokens[parser->toksuper]; - if (t->type == JSMN_OBJECT || - (t->type == JSMN_STRING && t->size != 0)) { + switch (c) { + /* In strict mode primitives are: numbers and booleans */ + case '-': case '0': case '1' : case '2': case '3' : case '4': + case '5': case '6': case '7' : case '8': case '9': + case 't': case 'f': case 'n' : +#ifndef JSMN_FULLY_STRICT + /* Allow Inf and NaN in any mode other than fully strict */ + case 'I': case 'N': +#endif + /* And they must not be keys of the object */ + if (tokens != NULL && parser->toksuper != -1) { + jsmntok_t *t = &tokens[parser->toksuper]; + if (t->type == JSMN_OBJECT || + (t->type == JSMN_STRING && t->size != 0)) { + return JSMN_ERROR_INVAL; + } + } + break; + + default: + /* Unexpected char in strict mode */ return JSMN_ERROR_INVAL; - } } -#else - /* In non-strict mode every unquoted value is a primitive */ - default: #endif r = jsmn_parse_primitive(parser, js, len, tokens, num_tokens); if (r < 0) return r; - count++; if (parser->toksuper != -1 && tokens != NULL) tokens[parser->toksuper].size++; break; - -#ifdef JSMN_STRICT - /* Unexpected char in strict mode */ - default: - return JSMN_ERROR_INVAL; -#endif } } @@ -303,7 +317,7 @@ int jsmn_parse(jsmn_parser *parser, const char *js, size_t len, } } - return count; + return parser->count; } /** @@ -314,5 +328,7 @@ void jsmn_init(jsmn_parser *parser) { parser->pos = 0; parser->toknext = 0; parser->toksuper = -1; + parser->count = 0; + parser->line = 1; } diff --git a/jsmn/jsmn.h b/jsmn/jsmn.h index 01ca99c..e6ee22c 100644 --- a/jsmn/jsmn.h +++ b/jsmn/jsmn.h @@ -42,6 +42,7 @@ typedef struct { int start; int end; int size; + int line; #ifdef JSMN_PARENT_LINKS int parent; #endif @@ -54,7 +55,9 @@ typedef struct { typedef struct { unsigned int pos; /* offset in the JSON string */ unsigned int toknext; /* next token to allocate */ + unsigned int count; /* number of tokens parsed */ int toksuper; /* superior token node, e.g parent object or array */ + int line; /* current line number */ } jsmn_parser; /** diff --git a/linenoise.c b/linenoise.c index 8b628fe..0d2fee5 100644 --- a/linenoise.c +++ b/linenoise.c @@ -1,3 +1,4 @@ +#line 1 "stringbuf.h" #ifndef STRINGBUF_H #define STRINGBUF_H /** @@ -135,6 +136,7 @@ char *sb_to_string(stringbuf *sb); #endif #endif +#line 1 "stringbuf.c" /** * resizable string buffer * @@ -180,7 +182,7 @@ void sb_free(stringbuf *sb) free(sb); } -void sb_realloc(stringbuf *sb, int newlen) +static void sb_realloc(stringbuf *sb, int newlen) { sb->data = (char *)realloc(sb->data, newlen); sb->remaining = newlen - sb->last; @@ -308,6 +310,7 @@ void sb_clear(stringbuf *sb) #endif } } +#line 1 "linenoise.c" /* linenoise.c -- guerrilla line editing library against the idea that a * line editing lib needs to be 20,000 lines of C code. * @@ -425,10 +428,6 @@ void sb_clear(stringbuf *sb) #define USE_WINCONSOLE #ifdef __MINGW32__ #define HAVE_UNISTD_H -#else -/* Microsoft headers don't like old POSIX names */ -#define strdup _strdup -#define snprintf _snprintf #endif #else #include <termios.h> @@ -451,6 +450,12 @@ void sb_clear(stringbuf *sb) #include <stdlib.h> #include <sys/types.h> +#if defined(_WIN32) && !defined(__MINGW32__) +/* Microsoft headers don't like old POSIX names */ +#define strdup _strdup +#define snprintf _snprintf +#endif + #include "linenoise.h" #ifndef STRINGBUF_H #include "stringbuf.h" @@ -488,6 +493,7 @@ enum { static int history_max_len = LINENOISE_DEFAULT_HISTORY_MAX_LEN; static int history_len = 0; +static int history_index = 0; static char **history = NULL; /* Structure to contain the status of the current (being edited) line */ @@ -504,6 +510,8 @@ struct current { stringbuf *output; /* used only during refreshLine() - output accumulator */ #if defined(USE_TERMIOS) int fd; /* Terminal fd */ + int pending; /* pending char fd_read_char() */ + int query_cursor_failed; /* if 1, don't try to query the cursor position again */ #elif defined(USE_WINCONSOLE) HANDLE outh; /* Console output handle */ HANDLE inh; /* Console input handle */ @@ -530,6 +538,16 @@ static void setCursorPos(struct current *current, int x); static void setOutputHighlight(struct current *current, const int *props, int nprops); static void set_current(struct current *current, const char *str); +static int fd_isatty(struct current *current) +{ +#ifdef USE_TERMIOS + return isatty(current->fd); +#else + (void)current; + return 0; +#endif +} + void linenoiseHistoryFree(void) { if (history) { int j; @@ -832,25 +850,31 @@ void linenoiseClearScreen(void) } /** - * Reads a char from 'fd', waiting at most 'timeout' milliseconds. + * Reads a char from 'current->fd', waiting at most 'timeout' milliseconds. * * A timeout of -1 means to wait forever. * * Returns -1 if no char is received within the time or an error occurs. */ -static int fd_read_char(int fd, int timeout) +static int fd_read_char(struct current *current, int timeout) { struct pollfd p; unsigned char c; - p.fd = fd; + if (current->pending) { + c = current->pending; + current->pending = 0; + return c; + } + + p.fd = current->fd; p.events = POLLIN; if (poll(&p, 1, timeout) == 0) { /* timeout */ return -1; } - if (read(fd, &c, 1) != 1) { + if (read(current->fd, &c, 1) != 1) { return -1; } return c; @@ -868,7 +892,11 @@ static int fd_read(struct current *current) int i; int c; - if (read(current->fd, &buf[0], 1) != 1) { + if (current->pending) { + buf[0] = current->pending; + current->pending = 0; + } + else if (read(current->fd, &buf[0], 1) != 1) { return -1; } n = utf8_charlen(buf[0]); @@ -884,7 +912,7 @@ static int fd_read(struct current *current) utf8_tounicode(buf, &c); return c; #else - return fd_read_char(current->fd, -1); + return fd_read_char(current, -1); #endif } @@ -898,6 +926,11 @@ static int queryCursor(struct current *current, int* cols) struct esc_parser parser; int ch; + if (current->query_cursor_failed) { + /* If it every fails, don't try again */ + return 0; + } + /* Should not be buffering this output, it needs to go immediately */ assert(current->output == NULL); @@ -906,7 +939,7 @@ static int queryCursor(struct current *current, int* cols) /* Parse the response: ESC [ rows ; cols R */ initParseEscapeSeq(&parser, 'R'); - while ((ch = fd_read_char(current->fd, 100)) > 0) { + while ((ch = fd_read_char(current, 100)) > 0) { switch (parseEscapeSequence(&parser, ch)) { default: continue; @@ -917,11 +950,14 @@ static int queryCursor(struct current *current, int* cols) } break; case EP_ERROR: + /* Push back the character that caused the error */ + current->pending = ch; break; } /* failed */ break; } + current->query_cursor_failed = 1; return 0; } @@ -988,20 +1024,20 @@ static int getWindowSize(struct current *current) * If no additional char is received within a short time, * CHAR_ESCAPE is returned. */ -static int check_special(int fd) +static int check_special(struct current *current) { - int c = fd_read_char(fd, 50); + int c = fd_read_char(current, 50); int c2; if (c < 0) { return CHAR_ESCAPE; } - else if (c >= 'a' && c <= 'z') { - /* esc-a => meta-a */ - return meta(c); - } + else if (c >= 'a' && c <= 'z') { + /* esc-a => meta-a */ + return meta(c); + } - c2 = fd_read_char(fd, 50); + c2 = fd_read_char(current, 50); if (c2 < 0) { return c2; } @@ -1024,7 +1060,7 @@ static int check_special(int fd) } if (c == '[' && c2 >= '1' && c2 <= '8') { /* extended escape */ - c = fd_read_char(fd, 50); + c = fd_read_char(current, 50); if (c == '~') { switch (c2) { case '2': @@ -1043,7 +1079,7 @@ static int check_special(int fd) } while (c != -1 && c != '~') { /* .e.g \e[12~ or '\e[11;2~ discard the complete sequence */ - c = fd_read_char(fd, 50); + c = fd_read_char(current, 50); } } @@ -1112,7 +1148,7 @@ static linenoiseHintsCallback *hintsCallback = NULL; static linenoiseFreeHintsCallback *freeHintsCallback = NULL; static void *hintsUserdata = NULL; -static void beep() { +static void beep(void) { #ifdef USE_TERMIOS fprintf(stderr, "\x7"); fflush(stderr); @@ -1783,6 +1819,26 @@ static int skip_nonspace(struct current *current, int dir) return skip_space_nonspace(current, dir, 0); } +static void set_history_index(struct current *current, int new_index) +{ + if (history_len > 1) { + /* Update the current history entry before to + * overwrite it with the next one. */ + free(history[history_len - 1 - history_index]); + history[history_len - 1 - history_index] = strdup(sb_str(current->buf)); + /* Show the new entry */ + history_index = new_index; + if (history_index < 0) { + history_index = 0; + } else if (history_index >= history_len) { + history_index = history_len - 1; + } else { + set_current(current, history[history_len - 1 - history_index]); + refreshLine(current); + } + } +} + /** * Returns the keycode to process, or 0 if none. */ @@ -1816,17 +1872,17 @@ static int reverseIncrementalSearch(struct current *current) } #ifdef USE_TERMIOS if (c == CHAR_ESCAPE) { - c = check_special(current->fd); + c = check_special(current); } #endif - if (c == ctrl('P') || c == SPECIAL_UP) { + if (c == ctrl('R')) { /* Search for the previous (earlier) match */ if (searchpos > 0) { searchpos--; } skipsame = 1; } - else if (c == ctrl('N') || c == SPECIAL_DOWN) { + else if (c == ctrl('S')) { /* Search for the next (later) match */ if (searchpos < history_len) { searchpos++; @@ -1834,6 +1890,18 @@ static int reverseIncrementalSearch(struct current *current) searchdir = 1; skipsame = 1; } + else if (c == ctrl('P') || c == SPECIAL_UP) { + /* Exit Ctrl-R mode and go to the previous history line from the current search pos */ + set_history_index(current, history_len - searchpos); + c = 0; + break; + } + else if (c == ctrl('N') || c == SPECIAL_DOWN) { + /* Exit Ctrl-R mode and go to the next history line from the current search pos */ + set_history_index(current, history_len - searchpos - 2); + c = 0; + break; + } else if (c >= ' ' && c <= '~') { /* >= here to allow for null terminator */ if (rlen >= (int)sizeof(rbuf) - MAX_UTF8_LEN) { @@ -1863,6 +1931,7 @@ static int reverseIncrementalSearch(struct current *current) continue; } /* Copy the matching line and set the cursor position */ + history_index = history_len - 1 - searchpos; set_current(current,history[searchpos]); current->pos = utf8_strlen(history[searchpos], p - history[searchpos]); break; @@ -1878,25 +1947,25 @@ static int reverseIncrementalSearch(struct current *current) if (c == ctrl('G') || c == ctrl('C')) { /* ctrl-g terminates the search with no effect */ set_current(current, ""); + history_index = 0; c = 0; } else if (c == ctrl('J')) { /* ctrl-j terminates the search leaving the buffer in place */ + history_index = 0; c = 0; } - /* Go process the char normally */ refreshLine(current); return c; } static int linenoiseEdit(struct current *current) { - int history_index = 0; + history_index = 0; refreshLine(current); while(1) { - int dir = -1; int c = fd_read(current); #ifndef NO_COMPLETION @@ -1915,7 +1984,7 @@ static int linenoiseEdit(struct current *current) { #ifdef USE_TERMIOS if (c == CHAR_ESCAPE) { /* escape sequence */ - c = check_special(current->fd); + c = check_special(current); } #endif if (c == -1) { @@ -2051,36 +2120,19 @@ static int linenoiseEdit(struct current *current) { refreshLine(current); } break; - case SPECIAL_PAGE_UP: - dir = history_len - history_index - 1; /* move to start of history */ - goto history_navigation; - case SPECIAL_PAGE_DOWN: - dir = -history_index; /* move to 0 == end of history, i.e. current */ - goto history_navigation; + case SPECIAL_PAGE_UP: /* move to start of history */ + set_history_index(current, history_len - 1); + break; + case SPECIAL_PAGE_DOWN: /* move to 0 == end of history, i.e. current */ + set_history_index(current, 0); + break; case ctrl('P'): case SPECIAL_UP: - dir = 1; - goto history_navigation; + set_history_index(current, history_index + 1); + break; case ctrl('N'): case SPECIAL_DOWN: -history_navigation: - if (history_len > 1) { - /* Update the current history entry before to - * overwrite it with tne next one. */ - free(history[history_len - 1 - history_index]); - history[history_len - 1 - history_index] = strdup(sb_str(current->buf)); - /* Show the new entry */ - history_index += dir; - if (history_index < 0) { - history_index = 0; - break; - } else if (history_index >= history_len) { - history_index = history_len - 1; - break; - } - set_current(current, history[history_len - 1 - history_index]); - refreshLine(current); - } + set_history_index(current, history_index - 1); break; case ctrl('A'): /* Ctrl+a, go to the start of the line */ case SPECIAL_HOME: @@ -2115,10 +2167,10 @@ history_navigation: refreshLine(current); break; default: - if (c >= meta('a') && c <= meta('z')) { - /* Don't insert meta chars that are not bound */ - break; - } + if (c >= meta('a') && c <= meta('z')) { + /* Don't insert meta chars that are not bound */ + break; + } /* Only tab is allowed without ^V */ if (c == '\t' || c >= ' ') { if (insert_char(current, current->pos, c) == 1) { @@ -2169,7 +2221,7 @@ static stringbuf *sb_getline(FILE *fh) /* ignore the effect of character count for partial utf8 sequences */ sb_append_len(sb, &ch, 1); } - if (n == 0) { + if (n == 0 || sb->data == NULL) { sb_free(sb); return NULL; } @@ -2188,6 +2240,10 @@ char *linenoiseWithInitial(const char *prompt, const char *initial) printf("%s", prompt); fflush(stdout); sb = sb_getline(stdin); + if (sb && !fd_isatty(¤t)) { + printf("%s\n", sb_str(sb)); + fflush(stdout); + } } else { current.buf = sb_alloc(); @@ -2195,9 +2251,9 @@ char *linenoiseWithInitial(const char *prompt, const char *initial) current.nrows = 1; current.prompt = prompt; - /* The latest history entry is always our current buffer */ - linenoiseHistoryAdd(initial); - set_current(¤t, initial); + /* The latest history entry is always our current buffer */ + linenoiseHistoryAdd(initial); + set_current(¤t, initial); count = linenoiseEdit(¤t); @@ -2216,11 +2272,11 @@ char *linenoiseWithInitial(const char *prompt, const char *initial) char *linenoise(const char *prompt) { - return linenoiseWithInitial(prompt, ""); + return linenoiseWithInitial(prompt, ""); } /* Using a circular buffer is smarter, but a bit more complex to handle. */ -int linenoiseHistoryAddAllocated(char *line) { +static int linenoiseHistoryAddAllocated(char *line) { if (history_max_len == 0) { notinserted: diff --git a/make-bootstrap-jim b/make-bootstrap-jim index 67ac71b..3a032a1 100755 --- a/make-bootstrap-jim +++ b/make-bootstrap-jim @@ -4,6 +4,26 @@ # which can be compiled to provide a bootstrap version of jimsh. # e.g. cc -o jimsh0 jimsh0.c +JIMREGEXP_H=jimregexp.h +JIMREGEXP_C=jimregexp.c +JIM_REGEXP=JIM_REGEXP + +while [ $# -gt 0 ]; do + case "$1" in + --no-regexp) + # don't include builtin regexp extension + JIMREGEXP_H="" + JIMREGEXP_C="" + JIM_REGEXP="" + ;; + *) + echo "Unknown option: $1" + exit 1 + ;; + esac + shift +done + makeext() { source="$1" @@ -40,16 +60,16 @@ EOF echo "}" } -cexts="aio readdir regexp file exec clock array posix" +cexts="aio readdir regexp file exec clock array" tclexts="bootstrap initjimsh glob stdlib tclcompat" # Note ordering -allexts="bootstrap aio readdir regexp file glob exec posix clock array stdlib tclcompat" +allexts="bootstrap aio readdir regexp file glob exec clock array stdlib tclcompat" echo "/* This is single source file, bootstrap version of Jim Tcl. See http://jim.tcl.tk/ */" # define some core features -for i in JIM_TCL_COMPAT JIM_ANSIC JIM_REGEXP HAVE_NO_AUTOCONF JIM_TINY _JIMAUTOCONF_H; do +for i in JIM_COMPAT JIM_ANSIC $JIM_REGEXP HAVE_NO_AUTOCONF JIM_TINY _JIMAUTOCONF_H; do echo "#define $i" done echo '#define TCL_LIBRARY "."' @@ -92,7 +112,11 @@ cat <<EOF #else #define _GNU_SOURCE #endif +#ifndef __ixemul__ #define HAVE_FORK +#else +#define HAVE_VFORK +#endif #define HAVE_WAITPID #define HAVE_ISATTY #define HAVE_MKSTEMP @@ -117,7 +141,7 @@ outputsource() } # Now output header files, removing references to jim header files -for i in jim-win32compat.h utf8.h jim.h jim-subcmd.h jimregexp.h jim-signal.h jimiocompat.h; do +for i in jim-win32compat.h utf8.h jim.h jim-subcmd.h $JIMREGEXP_H jim-signal.h jimiocompat.h; do outputsource $i done @@ -131,7 +155,7 @@ done makeloadexts $allexts # And finally the core source code -for i in jim.c jim-subcmd.c utf8.c jim-format.c jimregexp.c jimiocompat.c jim-win32compat.c jim-nosignal.c; do +for i in jim.c jim-subcmd.c utf8.c jim-format.c $JIMREGEXP_C jimiocompat.c jim-win32compat.c jim-nosignal.c; do outputsource $i done echo "#ifndef JIM_BOOTSTRAP_LIB_ONLY" @@ -9,8 +9,16 @@ set lines {} set commands {} array set cdict {} set c 0 +set numlist 1 while {[gets $f buf] >= 0} { + # Handle auto numbered lists + if {[string match "#. *" $buf]} { + set buf "$numlist. [string range $buf 3 end]" + incr numlist + } elseif {$buf eq ""} { + set numlist 1 + } if {[string match "~~*" $buf]} { if {[string match "*: *" $prev]} { incr c @@ -29,6 +37,8 @@ while {[gets $f buf] >= 0} { } } } + # Handle TIP nnn references + regsub -all {TIP ([0-9]+)} $buf {https://core.tcl-lang.org/tips/doc/main/tip/\1.md[TIP \1]} buf lappend lines $buf set prev $buf } diff --git a/make-release.sh b/make-release.sh index 07030c7..e8b844e 100755 --- a/make-release.sh +++ b/make-release.sh @@ -1,6 +1,6 @@ #!/bin/sh -version=`sed -n -e 's/.*JIM_VERSION *\([0-9]*\).*/0.\1/p' jim.h` +version=0.`sed -n -e 's/.*JIM_VERSION *\([0-9]*\).*/\1/p' auto.def` if [ `git clean -nqx | wc -l` -ne 0 ]; then git clean -nqx @@ -73,7 +73,7 @@ proc class {classname {baseclasses {}} classvars} { proc "$classname classvars" {} classvars { return $classvars } proc "$classname classname" {} classname { return $classname } proc "$classname methods" {} classname { - lsort [lmap p [info commands "$classname *"] { + lsort [lmap p [info commands -all "$classname *"] { lindex [split $p " "] 1 }] } diff --git a/regtest.tcl b/regtest.tcl index a9ee5eb..99a65fe 100644 --- a/regtest.tcl +++ b/regtest.tcl @@ -388,6 +388,24 @@ puts "TEST 54 PASSED" apply {{} {info frame 0}} puts "TEST 55 PASSED" +# json decode should not core dump on invalid input +set json { +{ + "fossil":"9c65b5432e4aeecf3556e5550c338ce93fd861cc", + "timestamp":1435827337, + "command":"timeline/checkin", /* this is line 3 */ + "procTimeUs":3333, +}} +catch {json::decode $json} +puts "TEST 56 PASSED" + +if {[exists -command debug]} { + set f [open /dev/null w] + $f puts [debug objects] + $f close +} +puts "TEST 57 PASSED" + # TAKE THE FOLLOWING puts AS LAST LINE puts "--- ALL TESTS PASSED ---" diff --git a/sqlite3/jim-sqlite.c b/sqlite3/jim-sqlite.c index 06ed7c0..8571a48 100644 --- a/sqlite3/jim-sqlite.c +++ b/sqlite3/jim-sqlite.c @@ -1502,10 +1502,6 @@ static int DbObjCmd(Jim_Interp *interp, int objc,Jim_Obj *const*objv){ }; /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */ - if( objc<2 ){ - Jim_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ..."); - return JIM_ERR; - } if( Jim_GetEnum(interp, objv[1], DB_strs, &choice, "option", JIM_ERRMSG | JIM_ENUM_ABBREV) ){ return JIM_ERR; } @@ -2356,19 +2352,21 @@ static int DbObjCmd(Jim_Interp *interp, int objc,Jim_Obj *const*objv){ ** 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; + else { + int nKey; + const char *pKey; + //pKey = Jim_GetByteArrayFromObj(objv[2], &nKey); + pKey = Jim_GetString(objv[2], &nKey); + rc = sqlite3_rekey(pDb->db, pKey, nKey); + if( rc ){ + Jim_SetResultString(interp, sqlite3ErrStr(rc), -1); + rc = JIM_ERR; + } } #endif break; @@ -2698,7 +2696,7 @@ static int DbMain(Jim_Interp *interp, int objc, Jim_Obj *const*objv){ const char *zVfs = 0; int flags; - /* Not threading in Jim, so no mutexing is needed */ + /* No threading in Jim, so no mutexing is needed */ flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE | SQLITE_OPEN_NOMUTEX; if( objc==2 ){ @@ -2765,14 +2763,7 @@ static int DbMain(Jim_Interp *interp, int objc, Jim_Obj *const*objv){ } } if( objc<3 || (objc&1)!=1 ){ - Jim_WrongNumArgs(interp, 1, objv, - "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?" - " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?" -#ifdef SQLITE_HAS_CODEC - " ?-key CODECKEY?" -#endif - ); - return JIM_ERR; + return JIM_USAGE; } zErrMsg = 0; p = (SqliteDb*)Jim_Alloc( sizeof(*p) ); @@ -2798,7 +2789,7 @@ static int DbMain(Jim_Interp *interp, int objc, Jim_Obj *const*objv){ p->maxStmt = NUM_PREPARED_STMTS; p->interp = interp; zArg = Jim_String(objv[1]); - Jim_CreateCommand(interp, zArg, DbObjCmd, p, DbDeleteCmd); + Jim_RegisterCmd(interp, zArg, "SUBCOMMAND ...", 1, -1, DbObjCmd, DbDeleteCmd, p, 0); return JIM_OK; } @@ -2823,6 +2814,14 @@ static int DbMain(Jim_Interp *interp, int objc, Jim_Obj *const*objv){ */ EXTERN int Jim_sqliteInit(Jim_Interp *interp){ Jim_PackageProvideCheck(interp, "sqlite"); - Jim_CreateCommand(interp, "sqlite", DbMain, 0, 0); + + static const char * const usage = + "HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?" + " ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?" +#ifdef SQLITE_HAS_CODEC + " ?-key CODECKEY?" +#endif + ; + Jim_RegisterCmd(interp, "sqlite", usage, 2, -1, DbMain, NULL, NULL, JIM_CMD_NOTAINT); return JIM_OK; } diff --git a/tclcompat.tcl b/tclcompat.tcl index 3485d00..11987c5 100644 --- a/tclcompat.tcl +++ b/tclcompat.tcl @@ -48,7 +48,7 @@ if {[exists -command stdout]} { $f buffering $v } -tr* { - # Just ignore -translation + $f translation $v } default { return -code error "fconfigure: unknown option $n" @@ -65,7 +65,9 @@ proc fileevent {args} { # Second, optional argument is a glob pattern # Third, optional argument is a "putter" function -proc parray {arrayname {pattern *} {puts puts}} { +# with args being additional arguments to the putter +# (invoked as $puts {*}$args string) +proc parray {arrayname {pattern *} {puts puts} args} { upvar $arrayname a set max 0 @@ -77,7 +79,7 @@ proc parray {arrayname {pattern *} {puts puts}} { incr max [string length $arrayname] incr max 2 foreach name [lsort [array names a $pattern]] { - $puts [format "%-${max}s = %s" $arrayname\($name\) $a($name)] + $puts {*}$args [format "%-${max}s = %s" $arrayname\($name\) $a($name)] } } @@ -137,9 +139,6 @@ proc popen {cmd {mode r}} { if {$cmd eq "pid"} { return $pids } - if {$cmd eq "getfd"} { - $f getfd - } if {$cmd eq "close"} { $f close # And wait for the child processes to complete diff --git a/tcltest.tcl b/tcltest.tcl index 1f13365..8d3d51e 100644 --- a/tcltest.tcl +++ b/tcltest.tcl @@ -168,8 +168,8 @@ proc basename-stacktrace {stacktrace} { # If tcl, just use tcltest if {[catch {info version}]} { - package require Tcl 8.5 - package require tcltest 2.1 + package require Tcl 8.5- + package require tcltest 2.1- namespace import tcltest::* if {$testinfo(verbose)} { @@ -185,7 +185,6 @@ if {[catch {info version}]} { incr skip for {set level $skip} {$level < [info frame] - $last} {incr level} { set frame [info frame -$level] - puts $frame if {[dict get $frame type] ne "source"} { continue } diff --git a/test-bootstrap-jim b/test-bootstrap-jim index ed5a67a..ac49a82 100755 --- a/test-bootstrap-jim +++ b/test-bootstrap-jim @@ -2,7 +2,7 @@ set -e echo "Building bootstrap jimsh" -./make-bootstrap-jim >jimsh_bootstrap.c +./make-bootstrap-jim "$@" >jimsh_bootstrap.c ${CC:-cc} -o jimsh_bootstrap jimsh_bootstrap.c echo "Testing bootstrap jimsh" ( cd tests; ../jimsh_bootstrap runall.tcl ) diff --git a/tests/breakcontinue.test b/tests/breakcont.test index ddf9438..ddf9438 100644 --- a/tests/breakcontinue.test +++ b/tests/breakcont.test diff --git a/tests/clock.test b/tests/clock.test index 0ef7bb3..26aa17e 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -5,7 +5,7 @@ constraint cmd {clock scan} test clock-1.1 {clock usage} -body { clock -} -returnCodes error -match glob -result {wrong # args: should be "clock command ..."*} +} -returnCodes error -match glob -result {wrong # args: should be "clock subcommand ?arg ...?"} test clock-1.2 {clock usage} -body { clock blah diff --git a/tests/coverage.test b/tests/coverage.test index 95933a3..48d1a3c 100644 --- a/tests/coverage.test +++ b/tests/coverage.test @@ -175,7 +175,7 @@ test cmd-1 {standard -commands} jim { test rand-1 {rand} -constraints rand -body { rand 1 2 3 -} -returnCodes error -result {wrong # args: should be "rand ?min? max"} +} -returnCodes error -result {wrong # args: should be "rand ?min? ?max?"} test rand-2 {rand} -constraints rand -body { rand foo diff --git a/tests/debug.test b/tests/debug.test index a86d472..1e6a3ec 100644 --- a/tests/debug.test +++ b/tests/debug.test @@ -7,7 +7,7 @@ set x 0 test debug-0.1 {debug too few args} -body { debug -} -returnCodes error -match glob -result {wrong # args: should be "debug command ..."*} +} -returnCodes error -match glob -result {wrong # args: should be "debug subcommand ?arg ...?"} test debug-0.2 {debug bad option} -body { debug badoption @@ -40,7 +40,7 @@ test debug-3.1 {debug objects} -body { # 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"} +} -returnCodes error -result {wrong # args: should be "debug objects ?-taint?"} test debug-4.1 {debug invstr too few args} -body { debug invstr @@ -100,7 +100,7 @@ test debug-8.1 {debug show} -body { set x hello lappend x there debug show $x -} -result {refcount: 2, type: list +} -result {refcount: 2, taint: 0, type: list chars (11): <<hello there>> bytes (11): 68 65 6c 6c 6f 20 74 68 65 72 65} diff --git a/tests/dict2.test b/tests/dict2.test index 94ba605..57cf069 100644 --- a/tests/dict2.test +++ b/tests/dict2.test @@ -22,9 +22,9 @@ proc dict-sort {dict} { return $result } -test dict-1.1 {dict command basic syntax} -returnCodes error -body { +test dict-1.1 {dict command basic syntax} -body { dict -} -match glob -result {wrong # args: should be "dict command ..."*} +} -returnCodes error -match glob -result {wrong # args: should be "dict subcommand ?arg ...?"} test dict-1.2 {dict command basic syntax} -returnCodes error -body { dict ? } -match glob -result * diff --git a/tests/event.test b/tests/event.test index 4f0b3c7..3a0f3bb 100644 --- a/tests/event.test +++ b/tests/event.test @@ -78,18 +78,24 @@ test event-7.4 {bgerror throws an error} -constraints jim -body { } after 0 {error err1} update - } + } 2>gorp.err + set f [open gorp.err] + set err [read $f] + close $f + set err } -result {stdin:3: Error: inside bgerror Traceback (most recent call last): File "stdin", line 6 bgerror err1 File "stdin", line 3, in bgerror - error {inside bgerror}} + error {inside bgerror} +} -cleanup { + file delete gorp.err +} # end of bgerror tests catch {rename bgerror {}} - test event-10.1 {Tcl_Exit procedure} exec { set cmd [list exec [info nameofexecutable] "<<exit 3"] list [catch $cmd msg] [lindex $errorCode 0] \ @@ -98,10 +104,8 @@ test event-10.1 {Tcl_Exit procedure} exec { test event-11.1 {Tcl_VwaitCmd procedure} -body { vwait -} -returnCodes error -match glob -result {wrong # args: should be "vwait* name"} -test event-11.2 {Tcl_VwaitCmd procedure} -body { - vwait a b -} -returnCodes error -match glob -result {wrong # args: should be "vwait* name"} +} -returnCodes error -result {wrong # args: should be "vwait ?-signal? name ?script?"} + test event-11.3 {Tcl_VwaitCmd procedure} jim { catch {unset x} set x 1 @@ -170,9 +174,10 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {s list $x $y $z } {3 3 done} -test event-12.1 {Tcl_UpdateCmd procedure} { - list [catch {update a b} msg] $msg -} {1 {wrong # args: should be "update ?idletasks?"}} +test event-12.1 {Tcl_UpdateCmd procedure - usage} -body { + update a b +} -returnCodes error -result {wrong # args: should be "update ?idletasks?"} + test event-12.3 {Tcl_UpdateCmd procedure} { foreach i [after info] { after cancel $i @@ -211,8 +216,8 @@ test event-13.1 "vwait/signal" signal { signal handle ALRM list [catch -signal { alarm 0.1 - # This is just to prevent the vwait from exiting immediately - stdin readable { format test } + # prevent the vwait from exiting immediately + after 1000 { } vwait forever } msg] $msg } {5 SIGALRM} @@ -263,5 +268,26 @@ test event-14.2 {IPv6 socket stream.server client address} {jim socket ipv6} { list [join [lrange [split $addr6 :] 0 end-1] :] } {{[::1]}} +test event-15.1 {vwait with script} {jim} { + set x 0 + set result {} + + local proc waiter {} {&x &result} { + lappend result $x + after 10 waiter + } + + after 10 waiter + vwait done_waiter [lambda {} {&x} { + # By using a lambda to capture a reference to x, we can + # avoid a global variable. (done_waiter is not used) + if {[incr x] >= 5} { + break + } + }] + # The vwait script iterates 5 times before break, so it will + # cancel the event loop before waiter sets done_waiter + list $x $result +} {5 {0 1 2 3 4}} testreport diff --git a/tests/exec-tip424.test b/tests/exec-tip424.test new file mode 100644 index 0000000..043c895 --- /dev/null +++ b/tests/exec-tip424.test @@ -0,0 +1,424 @@ +# The same tests as exec.test, but changed to TIP424 exec syntax + +source [file dirname [info script]]/testing.tcl + +needs cmd exec +needs cmd flush +# Need [pipe] to implement [open |command] +constraint cmd pipe + +constraint expr unix {$tcl_platform(platform) eq {unix}} + +# Sleep which supports fractions of a second +if {[info commands sleep] eq {}} { + proc sleep {n} { + exec {*}$::sleepx $n + } +} + +set f [open sleepx w] +puts $f { + sleep "$@" +} +close $f +#catch {exec chmod +x sleepx} +set sleepx [list sh sleepx] + +# Basic operations. + +test exec-1.1 {basic exec operation} { + exec | {echo a b c} +} "a b c" +test exec-1.2 {pipelining} { + exec | {echo a b c d} | cat | cat +} "a b c d" +test exec-1.3 {pipelining} { + set a [exec | {echo a b c d} | cat | wc] + list [scan $a "%d %d %d" b c d] $b $c +} {3 1 4} +set arg {12345678901234567890123456789012345678901234567890} +set arg "$arg$arg$arg$arg$arg$arg" +test exec-1.4 {long command lines} { + exec | [list echo $arg] +} $arg +set arg {} + +# I/O redirection: input from Tcl command. + +test exec-2.1 {redirecting input from immediate source} { + exec | cat << "Sample text" +} {Sample text} +test exec-2.2 {redirecting input from immediate source} { + exec | cat << "Sample text" | cat +} {Sample text} +test exec-2.4 {redirecting input from immediate source} { + exec | cat | cat << "Sample text" +} {Sample text} +test exec-2.5 {redirecting input from immediate source} { + exec | cat "<<Joined to arrows" +} {Joined to arrows} +test exec-2.6 {redirecting input from immediate source, with UTF} { + # If this fails, it may give back: + # "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1" + # If it does, this means that the UTF -> external conversion did not + # occur before writing out the temp file. + exec | cat << "\uE9\uE0\uFC\uF1" +} "\uE9\uE0\uFC\uF1" +test exec-2.7 {redirecting input from immediate source with nulls} { + exec | cat << "Sample\0text" +} "Sample\0text" + +# I/O redirection: output to file. + +file delete gorp.file +test exec-3.1 {redirecting output to file} { + exec | {echo "Some simple words"} > gorp.file + exec | {cat gorp.file} +} "Some simple words" +test exec-3.2 {redirecting output to file} { + exec | {echo "More simple words"} | cat >gorp.file | cat + exec | {cat gorp.file} +} "More simple words" +test exec-3.3 {redirecting output to file} { + exec | {echo "Different simple words"} > gorp.file | cat | cat + exec | {cat gorp.file} +} "Different simple words" +test exec-3.4 {redirecting output to file} { + exec | {echo "Some simple words"} >gorp.file + exec | {cat gorp.file} +} "Some simple words" +test exec-3.5 {redirecting output to file} { + exec | {echo "First line"} >gorp.file + exec | {echo "Second line"} >> gorp.file + exec | {cat gorp.file} +} "First line\nSecond line" +test exec-3.7 {redirecting output to file} { + set f [open gorp.file w] + puts $f "Line 1" + flush $f + exec | {echo "More text"} >@ $f + exec | {echo "Even more"} >@$f + puts $f "Line 3" + close $f + exec | {cat gorp.file} +} "Line 1\nMore text\nEven more\nLine 3" + +# I/O redirection: output and stderr to file. + +file delete gorp.file +test exec-4.1 {redirecting output and stderr to file} { + exec | {echo "test output"} >& gorp.file + exec | {cat gorp.file} +} "test output" +test exec-4.2 {redirecting output and stderr to file} { + list [exec | {sh -c "echo foo bar 1>&2"} >&gorp.file] \ + [exec | {cat gorp.file}] +} {{} {foo bar}} +test exec-4.3 {redirecting output and stderr to file} { + exec | {echo "first line"} > gorp.file + list [exec | {sh -c "echo foo bar 1>&2"} >>&gorp.file] \ + [exec | {cat gorp.file}] +} "{} {first line\nfoo bar}" +test exec-4.4 {redirecting output and stderr to file} { + set f [open gorp.file w] + puts $f "Line 1" + flush $f + exec | {echo "More text"} >&@ $f + exec | {echo "Even more"} >&@$f + puts $f "Line 3" + close $f + exec | {cat gorp.file} +} "Line 1\nMore text\nEven more\nLine 3" +test exec-4.5 {redirecting output and stderr to file} { + set f [open gorp.file w] + puts $f "Line 1" + flush $f + exec | {sh -c "echo foo bar 1>&2"} >&@ $f + exec | {sh -c "echo xyzzy 1>&2"} >&@$f + puts $f "Line 3" + close $f + exec | {cat gorp.file} +} "Line 1\nfoo bar\nxyzzy\nLine 3" + +# I/O redirection: input from file. + +exec | {echo "Just a few thoughts"} > gorp.file + +test exec-5.1 {redirecting input from file} { + exec | cat < gorp.file +} {Just a few thoughts} +test exec-5.2 {redirecting input from file} { + exec | cat | cat < gorp.file +} {Just a few thoughts} +test exec-5.3 {redirecting input from file} { + exec | cat < gorp.file | cat +} {Just a few thoughts} +test exec-5.5 {redirecting input from file} { + exec | cat <gorp.file +} {Just a few thoughts} +test exec-5.6 {redirecting input from file} { + set f [open gorp.file r] + set result [exec | cat <@ $f] + close $f + set result +} {Just a few thoughts} +test exec-5.7 {redirecting input from file} { + set f [open gorp.file r] + set result [exec | cat <@$f] + close $f + set result +} {Just a few thoughts} + +# I/O redirection: standard error through a pipeline. + +test exec-6.1 {redirecting stderr through a pipeline} { + exec | {sh -c "echo foo bar"} |& cat +} "foo bar" +test exec-6.2 {redirecting stderr through a pipeline} { + exec | {sh -c "echo foo bar 1>&2"} |& cat +} "foo bar" +test exec-6.3 {redirecting stderr through a pipeline} { + exec | {sh -c "echo foo bar 1>&2"} \ + |& cat |& cat +} "foo bar" + +# I/O redirection: combinations. + +file delete gorp.file2 +test exec-7.1 {multiple I/O redirections} { + exec | cat << "command input" > gorp.file2 < gorp.file + exec | {cat gorp.file2} +} {Just a few thoughts} +test exec-7.2 {multiple I/O redirections} { + exec cat < gorp.file << "command input" +} {command input} + +# Long input to command and output from command. + +set a [string repeat a 1000000] +test exec-8.1 {long input and output} { + string length [exec | cat << $a] +} 1000000 + +# More than 20 arguments to exec. + +test exec-8.1 {long input and output} { + exec | {echo 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23} +} {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23} + +# Commands that return errors. + +test exec-9.1 {commands returning errors} { + catch {exec | gorp456} +} {1} +test exec-9.2 {commands returning errors} { + catch {exec | {echo foo} | foo123} msg +} {1} +test exec-9.3 {commands returning errors} { + list [catch {exec | [list {*}$sleepx 0.1] | false | [list {*}$sleepx 0.1]} msg] +} {1} +test exec-9.4 {commands returning errors} jim { + list [catch {exec | false | {echo "foo bar"}} msg] $msg +} {1 {foo bar}} +test exec-9.5 {commands returning errors} { + list [catch {exec | gorp456 | {echo a b c}} msg] +} {1} +test exec-9.6 {commands returning errors} jim { + list [catch {exec | {sh -c "echo error msg 1>&2"}} msg] $msg +} {0 {error msg}} +test exec-9.7 {commands returning errors} jim { + # Note: Use sleep here to ensure the order + list [catch {exec | {sh -c "echo error msg 1 1>&2"} \ + | {sh -c "sleep 0.1; echo error msg 2 1>&2"}} msg] $msg +} {0 {error msg 1 +error msg 2}} + +# Errors in executing the Tcl command, as opposed to errors in the +# processes that are invoked. + +test exec-10.1 {errors in exec invocation} { + list [catch {exec |} msg] +} {1} +test exec-10.3 {errors in exec invocation} { + list [catch {exec | cat |} msg] $msg +} {1 {cmdlist required after |}} +test exec-10.4 {errors in exec invocation} { + list [catch {exec | cat | | cat} msg] $msg +} {1 {invalid redirection cat}} +test exec-10.5 {errors in exec invocation} { + list [catch {exec | cat | |& cat} msg] $msg +} {1 {invalid redirection cat}} +test exec-10.6 {errors in exec invocation} { + list [catch {exec | cat |&} msg] $msg +} {1 {cmdlist required after |&}} +test exec-10.7 {errors in exec invocation} { + list [catch {exec | cat <} msg] $msg +} {1 {can't specify "<" as last word in command}} +test exec-10.8 {errors in exec invocation} { + list [catch {exec | cat >} msg] $msg +} {1 {can't specify ">" as last word in command}} +test exec-10.9 {errors in exec invocation} { + list [catch {exec | cat <<} msg] $msg +} {1 {can't specify "<<" as last word in command}} +test exec-10.10 {errors in exec invocation} { + list [catch {exec | cat >>} msg] $msg +} {1 {can't specify ">>" as last word in command}} +test exec-10.11 {errors in exec invocation} { + list [catch {exec | cat >&} msg] $msg +} {1 {can't specify ">&" as last word in command}} +test exec-10.12 {errors in exec invocation} { + list [catch {exec | cat >>&} msg] $msg +} {1 {can't specify ">>&" as last word in command}} +test exec-10.13 {errors in exec invocation} { + list [catch {exec | cat >@} msg] $msg +} {1 {can't specify ">@" as last word in command}} +test exec-10.14 {errors in exec invocation} { + list [catch {exec | cat <@} msg] $msg +} {1 {can't specify "<@" as last word in command}} +test exec-10.15 {errors in exec invocation} { + list [catch {exec | cat < a/b/c} msg] [string tolower $msg] +} {1 {couldn't read file "a/b/c": no such file or directory}} +test exec-10.16 {errors in exec invocation} { + list [catch {exec | cat << foo > a/b/c} msg] [string tolower $msg] +} {1 {couldn't write file "a/b/c": no such file or directory}} +test exec-10.17 {errors in exec invocation} { + list [catch {exec | cat << foo > a/b/c} msg] [string tolower $msg] +} {1 {couldn't write file "a/b/c": no such file or directory}} +set f [open gorp.file w] +test exec-10.18 {errors in exec invocation} { + list [catch {exec | cat <<test <@ $f} msg] +} 1 +close $f +set f [open gorp.file r] +test exec-10.19 {errors in exec invocation} { + list [catch {exec | cat <<test >@ $f} msg] +} 1 +close $f + +# Commands in background. + +test exec-11.1 {commands in background} { + set x [lindex [time {exec | [list {*}$sleepx 0.2] &}] 0] + expr $x<1000000 +} 1 +test exec-11.2 {commands in background} { + list [catch {exec | {echo a &b}} msg] $msg +} {0 {a &b}} +test exec-11.3 {commands in background} { + llength [exec | [list {*}$sleepx 0.1] &] +} 1 +test exec-11.4 {commands in background} { + llength [exec | [list {*}$sleepx 0.1] | [list {*}$sleepx 0.1] | [list {*}$sleepx 0.1] &] +} 3 + +# Make sure that background commands are properly reaped when +# they eventually die. + +exec | [list {*}$sleepx 0.3] + +test exec-12.1 {reaping background processes} -constraints unix -body { + for {set i 0} {$i < 20} {incr i} { + exec | {echo foo} > exec.tmp1 & + } + exec | [list {*}$sleepx 0.1] + catch {exec | ps | {fgrep "echo foo"} | {fgrep -v grep} | wc} msg + lindex $msg 0 +} -cleanup { + file delete exec.tmp1 +} -result 0 + +# Redirecting standard error separately from standard output + +test exec-15.1 {standard error redirection} { + exec | {echo "First line"} > gorp.file + list [exec | {sh -c "echo foo bar 1>&2"} 2> gorp.file] \ + [exec | {cat gorp.file}] +} {{} {foo bar}} +test exec-15.2 {standard error redirection} { + list [exec | {sh -c "echo foo bar 1>&2"} \ + | {echo biz baz} >gorp.file 2> gorp.file2] \ + [exec | {cat gorp.file}] \ + [exec | {cat gorp.file2}] +} {{} {biz baz} {foo bar}} +test exec-15.3 {standard error redirection} { + list [exec | {sh -c "echo foo bar 1>&2"} \ + | {echo biz baz} 2>gorp.file > gorp.file2] \ + [exec | {cat gorp.file}] \ + [exec | {cat gorp.file2}] +} {{} {foo bar} {biz baz}} +test exec-15.4 {standard error redirection} { + set f [open gorp.file w] + puts $f "Line 1" + flush $f + exec | {sh -c "echo foo bar 1>&2"} 2>@ $f + puts $f "Line 3" + close $f + exec | {cat gorp.file} +} {Line 1 +foo bar +Line 3} +test exec-15.5 {standard error redirection} { + exec | {echo "First line"} > gorp.file + exec | {sh -c "echo foo bar 1>&2"} 2>> gorp.file + exec | {cat gorp.file} +} {First line +foo bar} +test exec-15.6 {standard error redirection} { + exec | {sh -c "echo foo bar 1>&2"} > gorp.file2 2> gorp.file \ + >& gorp.file 2> gorp.file2 | {echo biz baz} + list [exec | {cat gorp.file}] [exec | {cat gorp.file2}] +} {{biz baz} {foo bar}} +test exec-15.7 {combine standard output/standard error} -body { + exec | {sh -c "echo foo bar 1>&2"} > gorp.file 2>@1 + exec | {cat gorp.file} +} -cleanup { + file delete gorp.file gorp.file2 +} -result {foo bar} + +test exec-16.1 {flush output before exec} -body { + set f [open gorp.file w] + puts $f "First line" + exec | {echo "Second line"} >@ $f + puts $f "Third line" + close $f + exec | {cat gorp.file} +} -cleanup { + file delete gorp.file +} -result {First line +Second line +Third line} + +test exec-17.1 {redirecting from command pipeline} -setup { + makeFile "abc\nghi\njkl" gorp.file +} -constraints pipe -body { + set f [open "|| {cat gorp.file} | {wc -l}" r] + set result [lindex [exec | cat <@$f] 0] + close $f + set result +} -cleanup { + file delete gorp.file +} -result {3} + +test exec-17.2 {redirecting to command pipeline} -setup { + makeFile "abc\nghi\njkl" gorp.file +} -constraints pipe -body { + set f [open "|| {wc -l} >gorp2.file" w] + exec | {cat gorp.file} >@$f + flush $f + close $f + lindex [exec | {cat gorp2.file}] 0 +} -cleanup { + file delete gorp.file gorp2.file +} -result {3} + +test exec-17.3 {redirecting stderr to stdout} -body { + exec | {sh -c "echo foo bar 1>&2"} 2>@1 +} -result {foo bar} + +file delete sleepx + +# Now we probably have a lot of unreaped zombies at this point +# so reap them to avoid confusing further tests +wait + +testreport diff --git a/tests/exec.test b/tests/exec.test index 85014a7..ee76573 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -268,7 +268,8 @@ error msg 2}} test exec-10.1 {errors in exec invocation} { list [catch {exec} msg] } {1} -test exec-10.2 {errors in exec invocation} { +# Note that with TIP424 exec, this is no longer an error in Jim +test exec-10.2 {errors in exec invocation} tcl { list [catch {exec | cat} msg] $msg } {1 {illegal use of | or |& in command}} test exec-10.3 {errors in exec invocation} { @@ -443,6 +444,10 @@ test exec-17.2 {redirecting to command pipeline} -setup { file delete gorp.file gorp2.file } -result {3} +test exec-17.3 {redirecting stderr to stdout} -body { + exec sh -c "echo foo bar 1>&2" 2>@1 +} -result {foo bar} + file delete sleepx # Now we probably have a lot of unreaped zombies at this point diff --git a/tests/exec2.test b/tests/exec2.test index 9daef58..e63cbbd 100644 --- a/tests/exec2.test +++ b/tests/exec2.test @@ -172,4 +172,13 @@ test exec2-5.6 {wait -1 to wait for any child} -constraints {after jim nomingw32 list $status $($waitpid == $pid) $code } -result {CHILDSTATUS 1 0} +test exec2-5.7 {wait -nohang for child not finished} -constraints {after jim nomingw32} -body { + set pid [exec sleep 10 &] + # Get the status of the running child + wait -nohang $pid +} -result {NONE 0 -1} -cleanup { + kill $pid + wait $pid +} + testreport diff --git a/tests/exists.test b/tests/exists.test index 7531b0c..b46ec26 100644 --- a/tests/exists.test +++ b/tests/exists.test @@ -76,12 +76,28 @@ test exists-1.16 "Exists local lambda" lambda { a } 1 -test exists-1.17 {exists usage} -body { +test exists-1.17 "Exists -channel" { + exists -channel bogus +} 0 + +test exists-1.18 "Exists -channel" { + exists -channel stdout +} 1 + +test exists-1.19 "Exists -channel" { + exists -channel info +} 0 + +test exists-1.20 "Exists -channel" { + exists -channel a +} 0 + +test exists-2.1 {exists usage} -body { exists -dummy blah -} -returnCodes error -result {bad option "-dummy": must be -alias, -command, -proc, or -var} +} -returnCodes error -result {bad option "-dummy": must be -alias, -channel, -command, -proc, or -var} -test exists-1.18 {exists usage} -body { +test exists-2.2 {exists usage} -body { exists abc def ghi -} -returnCodes error -result {wrong # args: should be "exists ?option? name"} +} -returnCodes error -result {wrong # args: should be "exists ?-command|-proc|-alias|-channel|-var? name"} testreport diff --git a/tests/expr.test b/tests/expr.test index 7e26c0a..bc52afd 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -154,5 +154,12 @@ test expr-5.3 {boolean in expression} { expr {true ? 4 : 5} } {4} +test expr-6.1 "Unary negation on boolean - should return error" -body { + expr {-true} +} -returnCodes error -result {can't use non-numeric string as operand of "-"} + +test expr-6.2 "Unary plus on boolean - should return error" -body { + expr {+true} +} -returnCodes error -result {can't use non-numeric string as operand of "+"} testreport diff --git a/tests/forget-test.tcl b/tests/forget-test.tcl new file mode 100644 index 0000000..8d4289b --- /dev/null +++ b/tests/forget-test.tcl @@ -0,0 +1,3 @@ +# This is a dummy package used for testing package forget + +set forgotten 1 diff --git a/tests/history.test b/tests/history.test index e0ff0e2..f0fa05a 100644 --- a/tests/history.test +++ b/tests/history.test @@ -4,9 +4,8 @@ needs cmd {history save} needs expr "jim::lineedit" {$jim::lineedit} test history-1.1 {history usage} -body { - history -} -returnCodes error -result {wrong # args: should be "history command ..." -Use "history -help ?command?" for help} + history +} -returnCodes error -result {wrong # args: should be "history subcommand ?arg ...?"} test history-1.2 {history -help} -body { history -help diff --git a/tests/interactive.test b/tests/interactive.test index 8d19512..e92b6d1 100644 --- a/tests/interactive.test +++ b/tests/interactive.test @@ -31,15 +31,15 @@ file delete test_history wait-for-prompt $p $p send "history load test_history\r" # skip echoed output -$p expect {\r\n} +$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} + $p expect "\r\n" # get command result - $p expect {\r\n} + $p expect "\r\n" $p before } -result {lindex linsert list} -cleanup { wait-for-prompt $p @@ -57,7 +57,7 @@ test interactive-1.2 {command line completion} lineedit { $p expect {list} { incr check } $p send \r } - $p expect {\r\n} + $p expect "\r\n" wait-for-prompt $p list $check $failed @@ -65,8 +65,8 @@ test interactive-1.2 {command line completion} lineedit { test interactive-1.3 {history show} -constraints lineedit -body { $p send "history show\r" - $p expect {\r\n} - $p expect {history show\r\n} + $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 @@ -74,11 +74,11 @@ test interactive-1.3 {history show} -constraints lineedit -body { test interactive-1.4 {history getline} -constraints lineedit -body { $p send "history getline {PROMPT> }\r" - $p expect {\r\n} + $p expect "\r\n" sleep 0.25 $p send "abc\bd\x01e\r" - $p expect {\r\n} - $p expect {\r\n} + $p expect "\r\n" + $p expect "\r\n" $p before } -result {eabd} -cleanup { wait-for-prompt $p @@ -86,16 +86,16 @@ test interactive-1.4 {history getline} -constraints lineedit -body { test interactive-1.5 {history getline} -constraints lineedit -body { $p send "set len \[history getline {PROMPT> } buf\]\r" - $p expect {\r\n} + $p expect "\r\n" sleep 0.25 $p send "abcde\r" - $p expect {\r\n} - $p expect {\r\n} + $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 expect "\r\n" + $p expect "\r\n" $p before } -result {5 abcde} -cleanup { wait-for-prompt $p @@ -108,9 +108,9 @@ test interactive-1.6 {insert wide character} -constraints {utf8 lineedit} -body $p send \x1bOD $p send y $p send \r - $p expect {\r\n} + $p expect "\r\n" sleep 0.25 - $p expect {\r\n} + $p expect "\r\n" $p before } -result ay\u1100b -cleanup { wait-for-prompt $p @@ -123,9 +123,9 @@ test interactive-1.7 {insert utf-8 combining character} -constraints {utf8 linee $p send \x1bOD $p send y $p send \r - $p expect {\r\n} + $p expect "\r\n" sleep 0.25 - $p expect {\r\n} + $p expect "\r\n" $p before } -result yx\u0300 -cleanup { wait-for-prompt $p diff --git a/tests/io.test b/tests/io.test new file mode 100644 index 0000000..1b06439 --- /dev/null +++ b/tests/io.test @@ -0,0 +1,26 @@ +source [file dirname [info script]]/testing.tcl + +# This is a proxy for tcl || tclcompat +constraint cmd fconfigure + +# The tests in this file are intended to test Tcl-compatible I/O features + +test io-1.1 {translation binary} -body { + # write a file via stdout in binary mode + # This will always work on Unix + set script { + fconfigure stdout -translation binary + puts line1 + puts line2 + } + exec [info nameofexecutable] << $script >binary.out + # Read it back in binary mode + set f [open binary.out rb] + set buf [read $f] + close $f + set buf +} -cleanup { + file delete binary.out +} -result "line1\nline2\n" + +testreport diff --git a/tests/jim.test b/tests/jim.test index 16e56fa..2d245db 100644 --- a/tests/jim.test +++ b/tests/jim.test @@ -3152,9 +3152,9 @@ test info-2.4 {info commands option} { } {_test1_ _test2_} catch {rename _test1_ {}} catch {rename _test2_ {}} -test info-2.5 {info commands option} { +test info-2.5 {info commands option} -body { list [catch {info commands a b} msg] $msg -} {1 {wrong # args: should be "info commands ?pattern?"}} + } -result {1 {wrong # args: should be "info commands ?-all? ?pattern?"}} test info-3.1 {info exists option} { set value foo info exists value @@ -3557,7 +3557,7 @@ catch {unset sum; unset err; unset i} ################################################################################ test env-1.1 {env} -body { env abc def ghi -} -returnCodes error -result {wrong # args: should be "env varName ?default?"} +} -returnCodes error -result {wrong # args: should be "env ?varName? ?default?"} test env-1.2 {env} -body { env DOES_NOT_EXIST abc diff --git a/tests/jimsh.test b/tests/jimsh.test index a02ed9f..8faf2d8 100644 --- a/tests/jimsh.test +++ b/tests/jimsh.test @@ -28,29 +28,17 @@ test jimsh-1.5 {jimsh --version} { test jimsh-1.6 {jimsh -e with error} -body { exec [info nameofexecutable] -e blah -} -returnCodes error -result {invalid command name "blah"} +} -returnCodes error -match glob -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.7 {jimsh exit code} -body { + set script "set x 3\nincr x\nexit \$x\n" + set rc [catch {exec [info nameofexecutable] << $script} msg opts] + lassign [dict get $opts -errorcode] status pid exitcode + list $rc $status $exitcode +} -result {1 CHILDSTATUS 4} -test jimsh-1.8 {jimsh prompt - error} -body { +test jimsh-1.8 {jimsh 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. " - +} -returnCodes error -match glob -result {stdin:1: Error: invalid command name "blah"*} testreport diff --git a/tests/json.test b/tests/json.test index ed73401..09c002c 100644 --- a/tests/json.test +++ b/tests/json.test @@ -3,7 +3,8 @@ source [file dirname [info script]]/testing.tcl needs cmd json::decode json needs cmd json::encode json -set json { +# Create a json string as though it was read from data.json +set json [info source { { "fossil":"9c65b5432e4aeecf3556e5550c338ce93fd861cc", "timestamp":1435827337, @@ -24,7 +25,7 @@ set json { "tags":["trunk"] }] } -}} +}} data.json 1] test json-decode-001 {top level keys} { lsort [dict keys [json::decode $json]] @@ -60,6 +61,7 @@ test json-decode-012 {default null value} { } {null} test json-decode-1.1 {Number forms} { + # Note that this is not strictly correct JSON, but is usable in practice json::decode {[ 1, 2, 3.0, 4, Infinity, NaN, -Infinity, -0.0, 1e5, -1e-5 ]} } {1 2 3.0 4 Inf NaN -Inf -0.0 1e5 -1e-5} @@ -80,15 +82,15 @@ test json-2.4 {schema tests} { } {obj a num b num} test json-2.5 {schema tests} { - lindex [json::decode -schema {[1, 2, {a:"b", c:false}, "hello"]}] 1 + lindex [json::decode -schema {[1, 2, {"a":"b", "c":false}, "hello"]}] 1 } {mixed num num {obj a str c bool} str} test json-2.6 {schema tests} { - lindex [json::decode -schema {[1, 2, {a:["b", 1, true, Infinity]}]}] 1 + lindex [json::decode -schema {[1, 2, {"a":["b", 1, true, Infinity]}]}] 1 } {mixed num num {obj a {mixed str num bool num}}} test json-2.7 {schema tests} { - lindex [json::decode -schema {[1, 2, {a:["b", 1, true, ["d", "e", "f"]]}]}] 1 + lindex [json::decode -schema {[1, 2, {"a":["b", 1, true, ["d", "e", "f"]]}]}] 1 } {mixed num num {obj a {mixed str num bool {list str}}}} test json-2.8 {schema tests} { @@ -96,10 +98,9 @@ test json-2.8 {schema tests} { } {mixed num num bool bool} test json-2.9 {schema tests} { - lindex [json::decode -schema {[{a:1},{b:2}]}] 1 + lindex [json::decode -schema {[{"a":1},{"b":2}]}] 1 } {mixed {obj a num} {obj b num}} - test json-3.1 {-index array} { json::decode -index \ {[null, 1, 2, true, false, "hello"]} @@ -122,6 +123,17 @@ test json-3.4 {-index array with -schema 2} { } "{outer {0 {key value} 1 {key2 value2}}}\ {obj outer {mixed {obj key str} {obj key2 str}}}" +test json-4.1 {source info preserved} -body { + info source [dict get [json::decode $json] fossil] +} -result {data.json 3} + +test json-4.2 {source info preserved} -body { + info source [dict get [json::decode $json] procTimeUs] +} -result {data.json 6} + +test json-4.3 {source info preserved} -body { + info source [dict get [lindex [dict get [json::decode $json] payload timeline] 0] comment] +} -result {data.json 17} unset -nocomplain json diff --git a/tests/loadtest.c b/tests/loadtest.c index 138e403..170e056 100644 --- a/tests/loadtest.c +++ b/tests/loadtest.c @@ -17,19 +17,11 @@ static const jim_subcmd_type loadtest_command_table[] = { { 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); + Jim_PackageProvideCheck(interp, "loadtest"); + Jim_RegisterSubCmd(interp, "loadtest", loadtest_command_table, NULL); return JIM_OK; } diff --git a/tests/loop.test b/tests/loop.test index c6144e0..43fe562 100644 --- a/tests/loop.test +++ b/tests/loop.test @@ -152,6 +152,15 @@ test loop-2.8 {modify loop var} { set a } {1 2 3 4 5} +# Previously this would leak memory (configure --maintainer) +test loop-2.9 {fail to set loop var} -body { + set i 1 + loop i(x) 1 6 { + incr y + } + set y +} -returnCodes error -result {can't set "i(x)": variable isn't array} + testreport break diff --git a/tests/lsort.test b/tests/lsort.test index 5297568..f60bc06 100644 --- a/tests/lsort.test +++ b/tests/lsort.test @@ -17,7 +17,7 @@ test lsort-1.1 {Tcl_LsortObjCmd procedure} jim { } {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, -stride, or -unique}} +} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -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 \{} @@ -207,6 +207,12 @@ test lsort-5.1 "Sort case insensitive" { lsort -nocase {ba aB aa ce} } {aa aB ba ce} +test cmdIL-1.8 {Tcl_LsortObjCmd procedure, -dictionary option} { + lsort -dictionary {d e c b a d35 d300} +} {a b c d d35 d300 e} +test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} { + lsort -dictionary {1k 0k 10k} +} {0k 1k 10k} test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} { lsort -stride 2 {f e d c b a} } {b a d c f e} @@ -237,5 +243,126 @@ test cmdIL-1.41 {lsort -stride and -index} -body { 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} +test cmdIL-3.8 {SortCompare procedure, -dictionary option} { + lsort -dictionary {d e c b a d35 d300 100 20} +} {20 100 a b c d d35 d300 e} + +test cmdIL-4.1 {DictionaryCompare procedure, numerics, leading zeros} { + lsort -dictionary {a003b a03b} +} {a03b a003b} +test cmdIL-4.2 {DictionaryCompare procedure, numerics, leading zeros} { + lsort -dictionary {a3b a03b} +} {a3b a03b} +# This test fails in Jim because we don't bother falling back to a secondary +# sort on case if the primary sort (with leading zeros) is equal. +test cmdIL-4.3 {DictionaryCompare procedure, numerics, leading zeros} tcl { + lsort -dictionary {a3b A03b} +} {A03b a3b} +test cmdIL-4.4 {DictionaryCompare procedure, numerics, leading zeros} { + lsort -dictionary {a3b a03B} +} {a3b a03B} +test cmdIL-4.5 {DictionaryCompare procedure, numerics, leading zeros} { + lsort -dictionary {00000 000} +} {000 00000} +test cmdIL-4.6 {DictionaryCompare procedure, numerics, different lengths} { + lsort -dictionary {a321b a03210b} +} {a321b a03210b} +test cmdIL-4.7 {DictionaryCompare procedure, numerics, different lengths} { + lsort -dictionary {a03210b a321b} +} {a321b a03210b} +test cmdIL-4.8 {DictionaryCompare procedure, numerics} { + lsort -dictionary {48 6a 18b 22a 21aa 35 36} +} {6a 18b 21aa 22a 35 36 48} +test cmdIL-4.9 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a123x a123b} +} {a123b a123x} +test cmdIL-4.10 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a123b a123x} +} {a123b a123x} +test cmdIL-4.11 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a1b aab} +} {a1b aab} +test cmdIL-4.12 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a1b a!b} +} {a!b a1b} +test cmdIL-4.13 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a1b2c a1b1c} +} {a1b1c a1b2c} +test cmdIL-4.14 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a1b2c a1b3c} +} {a1b2c a1b3c} +test cmdIL-4.15 {DictionaryCompare procedure, long numbers} { + lsort -dictionary {a7654884321988762b a7654884321988761b} +} {a7654884321988761b a7654884321988762b} +test cmdIL-4.16 {DictionaryCompare procedure, long numbers} { + lsort -dictionary {a8765488432198876b a7654884321988761b} +} {a7654884321988761b a8765488432198876b} +test cmdIL-4.17 {DictionaryCompare procedure, case} { + lsort -dictionary {aBCd abcc} +} {abcc aBCd} +test cmdIL-4.18 {DictionaryCompare procedure, case} { + lsort -dictionary {aBCd abce} +} {aBCd abce} +test cmdIL-4.19 {DictionaryCompare procedure, case} { + lsort -dictionary {abcd ABcc} +} {ABcc abcd} +test cmdIL-4.20 {DictionaryCompare procedure, case} { + lsort -dictionary {abcd ABce} +} {abcd ABce} +test cmdIL-4.21 {DictionaryCompare procedure, case} { + lsort -dictionary {abCD ABcd} +} {ABcd abCD} +test cmdIL-4.22 {DictionaryCompare procedure, case} { + lsort -dictionary {ABcd aBCd} +} {ABcd aBCd} +test cmdIL-4.23 {DictionaryCompare procedure, case} { + lsort -dictionary {ABcd AbCd} +} {ABcd AbCd} +test cmdIL-4.24 {DictionaryCompare procedure, international characters} utf8 { + set result [lsort -dictionary "a b c A B C \xe3 \xc4"] + set result +} "A a B b C c \xe3 \xc4" +test cmdIL-4.25 {DictionaryCompare procedure, international characters} utf8 { + set result [lsort -dictionary "a23\xe3 a23\xc5 a23\xe4"] + set result +} "a23\xe3 a23\xe4 a23\xc5" +test cmdIL-4.26 {DefaultCompare procedure, signed characters} { + set l [lsort [list "abc\200" "abc"]] + set viewlist {} + foreach s $l { + set viewelem "" + set len [string length $s] + for {set i 0} {$i < $len} {incr i} { + set c [string index $s $i] + scan $c %c d + if {$d > 0 && $d < 128} { + append viewelem $c + } else { + append viewelem "\\[format %03o $d]" + } + } + lappend viewlist $viewelem + } + set viewlist +} [list "abc" "abc\\200"] +test cmdIL-4.27 {DictionaryCompare procedure, signed characters} { + set l [lsort -dictionary [list "abc\200" "abc"]] + set viewlist {} + foreach s $l { + set viewelem "" + set len [string length $s] + for {set i 0} {$i < $len} {incr i} { + set c [string index $s $i] + scan $c %c d + if {$d > 0 && $d < 128} { + append viewelem $c + } else { + append viewelem "\\[format %03o $d]" + } + } + lappend viewlist $viewelem + } + set viewlist +} [list "abc" "abc\\200"] testreport diff --git a/tests/lsubst.test b/tests/lsubst.test new file mode 100644 index 0000000..1c2c082 --- /dev/null +++ b/tests/lsubst.test @@ -0,0 +1,139 @@ +source [file dirname [info script]]/testing.tcl + +needs cmd lsubst + +test lsubst-1.1 {no args} -body { + lsubst +} -returnCodes error -result {wrong # args: should be "lsubst ?-line? string"} + +test lsubst-1.2 {too many args} -body { + lsubst a b c +} -returnCodes error -result {wrong # args: should be "lsubst ?-line? string"} + +test lsubst-1.3 {basic, no subst} -body { + lsubst {a b c} +} -result {a b c} + +test lsubst-1.4 {basics, vars} -body { + set a 1 + set b "2 3" + set c "4 5 6" + set d ".1" + lsubst {$a $b $c$d} +} -result {1 {2 3} {4 5 6.1}} + +test lsubst-1.5 {comments} -body { + # It is helpful to be able to include comments in a list definition + # just like in a script + lsubst { + # comment line + 1 + 2 3 + # comment line with continuation \ + this is also a comments + 4 ;# comment at end of line + 5 + } +} -result {1 2 3 4 5} + +test lsubst-1.6 {commands} -body { + set a 0 + lsubst { + [incr a] + [incr a] + [list d e] + [string cat f g][string cat h i] + } +} -result {1 2 {d e} fghi} + +test lsubst-1.7 {expand} -body { + set a {1 2} + set space " " + set b {3 4 5} + lsubst { + {*}$a + {*}$a$space$b$space[list 6 7] + } +} -result {1 2 1 2 3 4 5 6 7} + +test lsubst-1.8 {empty case} -body { + lsubst { + # Nothing + } +} -result {} + +test lsubst-1.9 {backslash escapes} -body { + lsubst { + # char escapes + \r\n\t + # unicode escapes + \u00b5 + # hex escapes + \x41\x42 + } +} -result [list \r\n\t \u00b5 AB] + +test lsubst-1.10 {simple -line} -body { + set a {1 2} + set b {3 4 5} + lsubst -line { + # This line won't produce a list, but the next will produce a list with two elements + {*}$a + # And this one will have three elements + one two $b + } +} -result {{1 2} {one two {3 4 5}}} + +test lsubst-2.1 {error, missing [} -body { + lsubst { + # Missing bracket + [string cat + } +} -returnCodes error -result {unmatched "["} + +test lsubst-2.2 {error, invalid command} -body { + lsubst { + a + [dummy] + b + } +} -returnCodes error -result {invalid command name "dummy"} + +test lsubst-2.3 {error, unset variable} -body { + lsubst { + a + $doesnotexist + b + } +} -returnCodes error -result {can't read "doesnotexist": no such variable} + +test lsubst-2.4 {break} -body { + lsubst { + a + [break] + b + } +} -returnCodes error -result {invoked "break" outside of a loop} + +test lsubst-2.5 {continue} -body { + lsubst { + a + [continue] + b + } +} -returnCodes error -result {invoked "continue" outside of a loop} + +test lsubst-3.1 {preservation of line numbers} -body { + set x abc + set src1 [info source $x] + set list [lsubst { + a + $x + b + }] + if {[info source [lindex $list 1]] ne [info source $x]} { + error "source does not match + } +} -result {} + +testreport diff --git a/tests/package.test b/tests/package.test index b8afa18..1484bd6 100644 --- a/tests/package.test +++ b/tests/package.test @@ -20,5 +20,17 @@ test package-1.3 {package names} -body { expr {"stdlib" in [package names]} } -result 1 +test package-2.1 {package forget} -body { + # First pretend the package was loaded + package provide forget-test + # Now it won't load anything + package require forget-test + # Now forget it and another unloaded test + package forget forget-test missing + # And load the local package + package require forget-test + info exists forgotten +} -result 1 + testreport diff --git a/tests/regexp.test b/tests/regexp.test index 7aeb72e..2e60b64 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -37,12 +37,12 @@ test regexp-1.5 {basic regexp operation} { test regexp-1.6 {basic regexp operation} regexp_are { list [catch {regexp {} abc} msg] $msg } {0 1} -#test regexp-1.7 {regexp utf compliance} { -# # if not UTF-8 aware, result is "0 1" -# set foo "\u4e4eb q" -# regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar -# list [string compare $foo $bar] [regexp 4 $bar] -#} {0 0} +test regexp-1.7 {regexp utf compliance} { + # if not UTF-8 aware, result is "0 1" + set foo "\u4e4eb q" + regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar + list [string compare $foo $bar] [regexp 4 $bar] +} {0 0} test regexp-2.1 {getting substrings back from regexp} { @@ -193,15 +193,18 @@ test regexp-5.5 {exercise cache of compiled expressions} { regexp .*e xe } 1 -test regexp-6.1 {regexp errors} { +test regexp-6.1 {regexp errors} -body { list [catch {regexp a} msg] $msg -} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}} -test regexp-6.2 {regexp errors} { +} -result {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} + +test regexp-6.2 {regexp errors} -body { list [catch {regexp -nocase a} msg] $msg -} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}} -test regexp-6.3 {regexp errors} jim { +} -result {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} + +test regexp-6.3 {regexp errors} -body { list [catch {regexp -gorp a} msg] $msg -} {1 {bad switch "-gorp": must be --, -all, -indices, -inline, -line, -nocase, or -start}} +} -result {1 {bad option "-gorp": must be -all, -expanded, -indices, -inline, -line, -lineanchor, -linestop, -nocase, -start, or --}} + test regexp-6.4 {regexp errors} { catch {regexp a( b} msg } 1 @@ -219,13 +222,14 @@ test regexp-6.8 {regexp errors} jim { set f1 44 list [catch {regexp abc abc f1(f2)} msg] $msg } {1 {can't set "f1(f2)": variable isn't array}} -test regexp-6.9 {regexp errors, -start bad int check} { + +test regexp-6.9 {regexp errors, -start bad int check} -body { list [catch {regexp -start bogus {^$} {}} msg] $msg -} {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 ...?"}} +} -match glob -result {1 {bad index "bogus": must be int* or end\?\[+-\]int*\?}} +test regexp-6.10 {regexp errors, -start too few args} -body { + list [catch {regexp -all -start} msg] $msg +} -result {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} test regexp-7.1 {basic regsub operation} { list [regsub aa+ xaxaaaxaa 111&222 foo] $foo @@ -279,12 +283,12 @@ test regexp-7.16 {basic regsub operation} { set foo xxx list [regsub x "" y foo] $foo } {0 {}} -#test regexp-7.17 {regsub utf compliance} { -# # if not UTF-8 aware, result is "0 1" -# set foo "xyz555ijka\u4e4ebpqr" -# regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar -# list [string compare $foo $bar] [regexp 4 $bar] -#} {0 0} +test regexp-7.17 {regsub utf compliance} { + # if not UTF-8 aware, result is "0 1" + set foo "xyz555ijka\u4e4ebpqr" + regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar + list [string compare $foo $bar] [regexp 4 $bar] +} {0 0} test regexp-8.1 {case conversion in regsub} { list [regsub -nocase a(a+) xaAAaAAay & foo] $foo @@ -344,30 +348,32 @@ test regexp-10.3 {newline sensitivity in regsub} { set foo xxx list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo } "1 {dabc\n123\nxb}" -#test regexp-10.4 {partial newline sensitivity in regsub} { -# set foo xxx -# list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo -#} "1 {da\n123}" -#test regexp-10.5 {inverse partial newline sensitivity in regsub} { -# set foo xxx -# list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo -#} "1 {da\nb123\nxb}" +test regexp-10.4 {partial newline sensitivity in regsub} regexp_are { + set foo xxx + list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo +} "1 {da\n123}" +test regexp-10.5 {inverse partial newline sensitivity in regsub} regexp_are { + set foo xxx + list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo +} "1 {da\nb123\nxb}" test regexp-11.1 {regsub errors} { list [catch {regsub a b} msg] $msg -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexp-11.2 {regsub errors} { list [catch {regsub -nocase a b} msg] $msg -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexp-11.3 {regsub errors} { list [catch {regsub -nocase -all a b} msg] $msg -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexp-11.4 {regsub errors} { list [catch {regsub a b c d e f} msg] $msg -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} -test regexp-11.5 {regsub errors} -constraints jim -body { +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} + +test regexp-11.5 {regsub errors} -body { list [catch {regsub -gorp a b c} msg] $msg -} -result {1 {bad switch "-gorp": must be --, -all, -command, -line, -nocase, or -start}} +} -result {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -lineanchor, -linestop, -nocase, -start, or --}} + test regexp-11.6 {regsub errors} { catch {regsub -nocase a( b c d} msg } 1 @@ -376,9 +382,11 @@ test regexp-11.7 {regsub errors} jim { set f1 44 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg } {1 {can't set "f1(f2)": variable isn't array}} -test regexp-11.8 {regsub errors, -start bad int check} { + +test regexp-11.8 {regsub errors, -start bad int check} -body { list [catch {regsub -start bogus pattern string rep var} msg] $msg -} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}} +} -match glob -result {1 {bad index "bogus": must be int* or end\?\[+-\]int*\?}} + test regexp-11.9 {regsub without final variable name returns value} { regsub b abaca X } {aXaca} @@ -394,7 +402,7 @@ test regexp-11.12 {regsub without final variable name returns value} { } {a,bcd,c,ea,bcfd,cf,e} test regexp-11.13 {regsub errors, -start too few args} { list [catch {regsub -all -nocase -nocase -start} msg] $msg -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} # This test crashes on the Mac unless you increase the Stack Space to about 1 @@ -489,7 +497,7 @@ test regexp-16.3 {regsub -start} { catch {unset x} list [regsub -all -start 3 {z} hello {/&} x] $x } {0 hello} -test regexp-16.4 {regsub -start, \A behavior} { +test regexp-16.4 {regsub -start, \A behavior} regexp_are { 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 @@ -583,19 +591,24 @@ test regexp-18.12 {regexp -all -inline -indices} { regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh } {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}} +test regexp-18.13 {regexp -all with match vars} -body { + regexp -all a(b(c)d|e(f)g)h abcdhaefgh a b c d e + list $a $b $c $d $e +} -result {aefgh efg {} f {}} + test regexp-19.1 {regsub null replacement} { regsub -all {@} {@hel@lo@} "\0a\0" result list $result [string length $result] } "\0a\0hel\0a\0lo\0a\0 14" -#test regexp-20.1 {regsub shared object shimmering} { -# # Bug #461322 -# set a abcdefghijklmnopqurstuvwxyz -# set b $a -# set c abcdefghijklmnopqurstuvwxyz0123456789 -# regsub $a $c $b d -# list $d [string length $d] [string bytelength $d] -#} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] +test regexp-20.1 {regsub shared object shimmering} { + # Bug #461322 + set a abcdefghijklmnopqurstuvwxyz + set b $a + set c abcdefghijklmnopqurstuvwxyz0123456789 + regsub $a $c $b d + list $d [string length $d] [string bytelength $d] +} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] #test regexp-20.2 {regsub shared object shimmering with -about} { # eval regexp -about abc #} {0 {}} @@ -636,9 +649,9 @@ test regexp-21.9 {regexp works with empty string offset} { regexp -start 3 -- \$ {123} } {1} -#test regexp-21.10 {multiple matches handle newlines} { -# regsub -all -lineanchor -- {^#[^\n]*\n} "#one\n#two\n#three\n" foo\n -#} "foo\nfoo\nfoo\n" +test regexp-21.10 {multiple matches handle newlines} regexp_are { + regsub -all -lineanchor -- {^#[^\n]*\n} "#one\n#two\n#three\n" foo\n +} "foo\nfoo\nfoo\n" test regexp-21.11 {multiple matches handle newlines} { regsub -all -line -- ^ "a\nb\nc" \# @@ -661,30 +674,40 @@ test regexp-21.15 {Replace literal backslash} { set value } "\\abc\\def" +test regexp-21.16 {Replace nothing} { + regsub -all {x*} anything ! +} {!a!n!y!t!h!i!n!g!} + +test regexp-21.17 {Replace nothing via empty pattern} regexp_are { + # Interestingly in this case Tcl does not match + # at end of string while the previous case does + regsub -all {} anything ! +} {!a!n!y!t!h!i!n!g} + 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 { +test regexp-22.2 {reversed char range} {jim regexp_are} { 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} { +test regexp-22.3 {hex digits} regexp_are { regexp -all -inline {[\x6a-\x6c]+} "jlaksdjflkwueorilkj" } {jl k j lk lkj} -test regexp-22.4 {uppercase hex digits} { +test regexp-22.4 {uppercase hex digits} regexp_are { 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} { +test regexp-22.5 {invalid hex digits} regexp_are { regexp -all -inline {[\x9X\x6C]+} "jla\tX6djflyw\tueorilkj" } [list l \tX l \t l] -test regexp-22.6 {unicode hex digits} jim { +test regexp-22.6 {unicode hex digits} {jim regexp_are} { regexp -all -inline {[\u{41}-\u{00043}]+} "AVBASDFBABDFBAFBAFA" } {A BA BAB BA BA A} @@ -693,15 +716,15 @@ 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} { +test regexp-22.8 {unicode hex digits} regexp_are { regexp -all -inline {[\u0041-\u0043]+} "AVBASDFBABDFBAFBAFA" } {A BA BAB BA BA A} -test regexp-22.9 {\U unicode hex digits} { +test regexp-22.9 {\U unicode hex digits} regexp_are { regexp -all -inline {[\U00000041-\U00000043]+} "AVBASDFBABDFBAFBAFA" } {A BA BAB BA BA A} -test regexp-22.10 {Various char escapes} { +test regexp-22.10 {Various char escapes} regexp_are { set result {} foreach match [regexp -all -inline {[\e\f\v\t\b]+} "A\f\vBB\b\tC\x1BG"] { set chars {} @@ -714,15 +737,15 @@ test regexp-22.10 {Various char escapes} { join $result | } {12,11|8,9|27} -test regexp-22.11 {backslash as last char} -body { +test regexp-22.11 {backslash as last char} -constraints regexp_are -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 { +test regexp-22.12 {missing closing bracket} -constraints regexp_are -body { regexp -all -inline {[abc} "abcdefghi" } -returnCodes error -result {couldn't compile regular expression pattern: brackets [] not balanced} -test regexp-22.13 {empty alternative} { +test regexp-22.13 {empty alternative} regexp_are { regexp -all -inline {a(a|b|)c} "aacbacbaa" } {aac a ac {}} @@ -734,11 +757,11 @@ 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} { +test regexp-22.16 {\s in set} regexp_are { regexp -all -inline {[\sa]+} "aac\[b a\]c\tb-aa" } [list aa " a" \t aa] -test regexp-22.17 {\d in set} { +test regexp-22.17 {\d in set} regexp_are { regexp -all -inline {[a\d]+} "a0ac\[b a\]44c\tb-1aa7" } {a0a a 44 1aa7} @@ -761,13 +784,13 @@ test regexp-27.5 {regsub -command} { test regexp-27.6 {regsub -command} { regsub -command -all {(.)(.)} {abcdef} {list ,} } {, ab a b, cd c d, ef e f} -test regexp-27.7 {regsub -command representation smash} { +test regexp-27.7 {regsub -command representation smash} regexp_are { set ::s {123=456 789} regsub -command -all {\d+} $::s {apply {n { expr {[llength $::s] + $n} }}} } {125=458 791} -test regexp-27.8 {regsub -command representation smash} { +test regexp-27.8 {regsub -command representation smash} regexp_are { set ::t {apply {n { expr {[llength [lindex $::t 1 1 1]] + $n} }}} @@ -789,15 +812,15 @@ test reg-31.1 {[[:xdigit:]] behaves correctly when followed by [[:space:]]} { # Code used to produce {1 2:::DebugWin32 2 :::DebugWin32} !!! } {1 2 2 {}} -test reg-31.2 {scanner not reset in failed optional group} { +test reg-31.2 {scanner not reset in failed optional group} regexp_are { regexp -inline {^(?:(-)(?:(\w[\w-]*)\|)?)?(\w[\w-]*)$} -debug } {-debug - {} debug} -test reg-31.2 {invalid digit check in class} -body { +test reg-31.2 {invalid digit check in class} -constraints regexp_are -body { regexp {[[:digit:\0]} 1 } -returnCodes error -result {couldn't compile regular expression pattern: brackets [] not balanced} -test reg-31.3 {invalid trailing backslash} -body { +test reg-31.3 {invalid trailing backslash} -constraints regexp_are -body { regexp "\[abc\\" a } -returnCodes error -result {couldn't compile regular expression pattern: invalid escape \ sequence} diff --git a/tests/regexp2.test b/tests/regexp2.test index 571c981..c965cf9 100644 --- a/tests/regexp2.test +++ b/tests/regexp2.test @@ -463,12 +463,12 @@ test regexpComp-9.6 {-all option to regsub} { } } {1 123xxx} -#test regexpComp-10.1 {expanded syntax in regsub} { -# evalInProc { -# set foo xxx -# list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo -# } -#} {1 defc} +test regexpComp-10.1 {expanded syntax in regsub} { + evalInProc { + set foo xxx + list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo + } +} {1 defc} test regexpComp-10.2 {newline sensitivity in regsub} { evalInProc { set foo xxx @@ -481,18 +481,18 @@ test regexpComp-10.3 {newline sensitivity in regsub} { list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo } } "1 {dabc\n123\nxb}" -#test regexpComp-10.4 {partial newline sensitivity in regsub} { -# evalInProc { -# set foo xxx -# list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo -# } -#} "1 {da\n123}" -#test regexpComp-10.5 {inverse partial newline sensitivity in regsub} { -# evalInProc { -# set foo xxx -# list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo -# } -#} "1 {da\nb123\nxb}" +test regexpComp-10.4 {partial newline sensitivity in regsub} { + evalInProc { + set foo xxx + list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo + } +} "1 {da\n123}" +test regexpComp-10.5 {inverse partial newline sensitivity in regsub} { + evalInProc { + set foo xxx + 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 @@ -507,27 +507,29 @@ test regexpComp-11.1 {regsub errors} { evalInProc { list [catch {regsub a b} msg] $msg } -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexpComp-11.2 {regsub errors} { evalInProc { list [catch {regsub -nocase a b} msg] $msg } -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexpComp-11.3 {regsub errors} { evalInProc { list [catch {regsub -nocase -all a b} msg] $msg } -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} test regexpComp-11.4 {regsub errors} { evalInProc { list [catch {regsub a b c d e f} msg] $msg } -} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}} -#test regexpComp-11.5 {regsub errors} { -# evalInProc { -# list [catch {regsub -gorp a b c} msg] $msg -# } -#} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}} +} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} + +test regexpComp-11.5 {regsub errors} -body { + evalInProc { + list [catch {regsub -gorp a b c} msg] $msg + } +} -result {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -lineanchor, -linestop, -nocase, -start, or --}} + test regexpComp-11.6 {regsub errors} { evalInProc { list [catch {regsub -nocase a( b c d} msg] $msg @@ -805,11 +807,17 @@ test regexpComp-21.10 {regexp command compiling tests} { } } {3 barfbarobaro} # This useless expression fails. Jim returns "bar" -#test regexpComp-21.11 {regexp command compiling tests} { -# evalInProc { -# list [regsub -all "" "" bar str] $str -# } -#} {0 {}} +test regexpComp-21.11 {regexp command compiling tests} { + evalInProc { + list [regsub -all "" "" bar str] $str + } +} {0 {}} +test regexpComp-21.12 {regexp empty pattern with utf8} utf8 { + # Make sure the second char isn't sliced up + evalInProc { + regsub -all "" a\u0442bc ! + } +} "!a!\u0442!b!c" # We can forgive the underlying regexp engine for not supporting this. # Why not use this instead? "((^X)*|\$)" @@ -943,4 +951,36 @@ test regexp-25.3 {End of word} { regexp {\mcd\M} cdef } 0 +test regexp-25.4 {Braces not a repeat count} { + regexp "{abc}" "test{abc}def" +} 1 + +test regexp-25.5 {Repeat follows nothing} -body { + regexp "{3}" "test{3}def" +} -returnCodes error -match glob -result {couldn't compile regular expression pattern: *} + +test regexp-25.6 {Meta char after nothing is error} -body { + regexp "?" "te?st" +} -returnCodes error -match glob -result {couldn't compile regular expression pattern: *} + +test regexp-26.1 {regexp operator =~} jim { + expr {"abc" =~ "^a"} +} 1 + +test regexp-26.2 {regexp operator =~} jim { + expr {"abc" =~ "^b"} +} 0 + +test regexp-26.2 {regexp operator =~} jim { + expr {"abc" =~ ".b."} +} 1 + +test regexp-26.3 {regexp operator =~ invalid regexp} -constraints jim -body { + expr {"abc" =~ {[}} +} -returnCodes error -result {couldn't compile regular expression pattern: brackets [] not balanced} + +test regexp-27.1 {regexp expanded} -body { + regexp -expanded -all -inline { a ( b b ) + } {abbbbbbcde} +} -returnCodes ok -result {abbbbbb bb} + testreport diff --git a/tests/socket.test b/tests/socket.test index cc7d3d6..acb5347 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -120,6 +120,11 @@ test socket-1.7 {socketpair} -body { lassign [socket pair] s1 s2 $s1 buffering line $s2 buffering line + # We trust the data received on these sockets + if {[exists -command taint]} { + $s1 taint source 0 + $s2 taint source 0 + } stdout flush if {[os.fork] == 0} { $s1 close @@ -345,6 +350,10 @@ if {[os.fork] == 0} { # read everything available (non-blocking read) set buf [$c read] if {[string length $buf]} { + # It is safe to send this back to where it came from + if {[exists -command untaint]} { + untaint buf + } $c puts -nonewline $buf $c flush } diff --git a/tests/ssl.test b/tests/ssl.test index d147c92..7c69358 100644 --- a/tests/ssl.test +++ b/tests/ssl.test @@ -22,6 +22,10 @@ if {[os.fork] == 0} { $c readable { # read everything available and echo it back set buf [$c read] + # We don't mind sending tainted data back to it's source + if {[exists -command taint]} { + untaint buf + } $c puts -nonewline $buf $c flush if {[$c eof]} { diff --git a/tests/stringmatch.test b/tests/stringmatch.test index f0eab2a..2a60631 100644 --- a/tests/stringmatch.test +++ b/tests/stringmatch.test @@ -230,4 +230,16 @@ test stringmatch-7.4 {null in pattern} { string match *b\[\0a\]r* foobar } 1 +test regexp-8.1 {string match operator =*} { + expr {"abc" =* "a*"} +} 1 + +test regexp-26.2 {regexp operator =~} { + expr {"abc" =* "b*"} +} 0 + +test regexp-26.2 {regexp operator =~} { + expr {"abc" =* {*[bB]c}} +} 1 + testreport diff --git a/tests/taint.test b/tests/taint.test new file mode 100644 index 0000000..3e924f8 --- /dev/null +++ b/tests/taint.test @@ -0,0 +1,212 @@ +source [file dirname [info script]]/testing.tcl + +needs cmd taint + +# create a tainted var +set t tainted +taint t + +test taint-1.1 {taint simple var} { + info tainted $t +} 1 + +test taint-1.2 {set taint, simple var} { + set x $t + info tainted $x +} 1 + +test taint-1.3 {untaint ref counting simple var} { + untaint x + list [info tainted $x] [info tainted $t] +} {0 1} + +# Tainting an array element taints the array/dict, but +# not each element +test taint-1.4 {taint array var} { + set a {1 one 2 two} + taint a(2) + list [info tainted $a(1)] [info tainted $a(2)] [info tainted $a] +} {0 1 1} + +# Adding a tainted value to an array taints the array/dict, but +# not each element +test taint-1.5 {tainted value taints dict} { + unset -nocomplain a + array set a {1 one 2 two} + set a(3) $t + list [info tainted $a(1)] [info tainted $a(3)] [info tainted $a] +} {0 1 1} + +# lappend taints the list, but not each element +test taint-1.6 {lappend with taint} { + set a {1 2} + lappend a $t + list [info tainted $a] [lmap p $a {info tainted $p}] +} {1 {0 0 1}} + +# lset taints the list, but not each element +test taint-1.7 {lset with taint} { + set a [list a b c d] + lset a 1 $t + list [info tainted $a] [lmap p $a {info tainted $p}] +} {1 {0 1 0 0}} + +# append taints the string +test taint-1.8 {append with taint} { + set a abc + append a $t + info tainted $a +} 1 + +test taint-1.9 {taint entire list} { + set a [list 1 2 3] + taint a + list [info tainted $a] [lmap p $a {info tainted $p}] +} {1 {1 1 1}} + +test taint-1.10 {taint entire dict} { + set a [dict create a 1 b 2 c 3] + taint a + list [info tainted $a] [info tainted [dict get $a b]] +} {1 1} + + +test taint-1.11 {interpolation with taint} { + set x "x$t" + info tainted $x +} 1 + +test taint-1.12 {lrange with taint} { + set a [list 1 2 3 $t 5 6] + info tainted [lrange $a 0 1] +} 0 + +test taint-1.13 {lrange with taint} { + set a [list 1 2 3 $t 5 6] + info tainted [lrange $a 2 4] +} 1 + +test taint-1.14 {lindex with taint} { + set a [list 1 2 3 $t 5 6] + info tainted [lindex $a 1] +} 0 + +test taint-1.15 {lassign with taint} { + set a [list 1 $t 3] + lassign $a x y z + list [info tainted $x] [info tainted $y] [info tainted $z] +} {0 1 0} + +test taint-1.16 {lreverse with taint} { + set a [lreverse [list 1 2 $t]] + list [info tainted $a] [lmap p $a {info tainted $p}] +} {1 {1 0 0}} + +test taint-1.17 {lsort with taint} { + set a [lsort [list zzz aaa $t bbb ppp]] + list [info tainted $a] [lmap p $a {info tainted $p}] +} {1 {0 0 0 1 0}} + +test taint-1.18 {lreplace with taint} { + set a {a b c} + set b [lreplace $a 1 1 $t] + list [info tainted $b] [lmap p $b {info tainted $p}] +} {1 {0 1 0}} + +test taint-1.19 {dict with taint} { + set a [dict create a 1 b 2 c $t d 4] + info tainted $a +} 1 + +test taint-1.20 {dict with taint} { + set a [dict create a 1 b 2 c $t d 4] + info tainted [dict get $a b] +} 0 + +test taint-1.21 {dict with taint} { + set a [dict create a 1 b 2 c $t d 4] + info tainted [dict get $a c] +} 1 + +test taint-1.22 {dict with taint} { + dict set a $t e + set result {} + foreach i [lsort [dict keys $a]] { + set v [dict get $a $i] + lappend result [list $i $v [info tainted $i] [info tainted $v]] + } + set result +} {{a 1 0 0} {b 2 0 0} {c tainted 0 1} {d 4 0 0} {tainted e 1 0}} + +test taint-1.23 {nested dict with taint} { + set a [dict create] + dict set a 1 A 1-A + dict set a 2 A 2-A + dict set a 1 T $t + info tainted $a +} 1 + +test taint-2.1 {exec with tainted data} -body { + exec $t +} -returnCodes error -result {exec: tainted data} + +test taint-2.2 {eval with tainted data - allowed} { + eval "set a $t" +} tainted + +test taint-2.3 {eval with braced tainted data - allowed} { + eval {set a $t} +} tainted + +test taint-2.4 {eval exec with tainted data} -body { + eval {exec $t} +} -returnCodes error -result {exec: tainted data} + +test taint-2.5 {open with tainted data} -body { + open "|$t" +} -returnCodes error -result {open: tainted data} + +test taint-2.6 {file delete with tainted data} -body { + file delete $t +} -returnCodes error -result {file delete: tainted data} + +test taint-2.7 {check errorcode on tainted data} -body { + try { + eval {exec $t} + } on error {msg opts} { + dict get $opts -errorcode + } +} -result {TAINTED} + +test taint-3.1 {filehandle not taint source by default} { + set f [open [info script]] + gets $f buf + info tainted $buf +} 0 + +test taint-3.2 {set taint source on filehandle} { + $f taint source 1 + gets $f buf + info tainted $buf +} 1 + +test taint-3.3 {filehandle not taint sink by default} -body { + set g [open out.tmp w] + puts $g $t +} -result {} + +test taint-3.4 {set taint sink on filehandle} -body { + $g taint sink 1 + puts $g $t +} -returnCodes error -result "puts: tainted data" + +test taint-3.5 {copyto taint source to sink} -body { + $f copyto $g +} -returnCodes error -result {copying tainted source} + +$f close +$g close + +file delete out.tmp + +testreport diff --git a/tests/try.test b/tests/try.test index 0d76865..36a9bf9 100644 --- a/tests/try.test +++ b/tests/try.test @@ -104,7 +104,7 @@ test try-2.1 "try ... trap" -body { try { a } trap CUSTOM {msg opts} { - list $msg $opts(-code) $opts(-errorcode) + list $msg [dict get $opts -code] [dict get $opts -errorcode] } } -result {{custom errorcode} 1 {CUSTOM RESULT}} @@ -140,6 +140,13 @@ test try-2.5 "trap match first but not second" -body { } } -returnCodes error -result failed +test try-2.6 "trap match too long" -body { + try { + apply {{} {return -code error -errorcode {FOO BAR} failed}} + } trap {FOO BAR BAZ} {msg opts} { + list trapped + } +} -returnCodes error -result failed proc c {} { try { |