Commit 27fbbb46be51c6f90eb3aba81d662ba7395e6eeb - jimtcl

Update upstream source from tag 'upstream/0.81' Update to upstream version '0.81' with Debian dir b8f50bf1eaaf141125d39da4ac630f1f7dba5172 vimer 2 years ago

177 changed file(s) with 16131 addition(s) and 7915 deletion(s). Raw diff Collapse all Expand all

-0

.gitignore less more

0	0	config.log
1	1	tags
2	2	/Makefile
	3	/examples.api/Makefile
	4	/tests/Makefile
3	5	Tcl.html
4	6	jimautoconf.h
5	7	jimautoconfext.h

18	20	configure.gnu
19	21	jimsh0
20	22	build-jim-ext
	23	*.gcda
	24	*.gcno
	25	*.gcov
	26	coverage*.html
	27	jimtcl.pc

-2

.travis.yml less more

3	3	apt:
4	4	packages:
5	5	- libsqlite3-dev
	6	- libhiredis-dev
6	7	before_script:
7		- ./configure --full --with-ext="sqlite3 zlib" --disable-docs
	8	- ./configure --maintainer --full --allextmod --disable-docs
8	9	script:
9		- make test
	10	- make all test
	11	- ./test-bootstrap-jim

-3

AUTHORS less more

10	10
11	11	some of the idea inside Jim are the fruit of long discussions
12	12	inside the Tclers chat room. The feedback of the Tcl
13		comunity in general, and of the members of the Tcl Core Team, was
	13	community in general, and of the members of the Tcl Core Team, was
14	14	very important to avoid mistakes: I used the great experience of
15	15	this people as a test for some of the ideas I put into Jim.
16	16	Bad ideas tend to be demolished in no time by good engineers.

20	20	- Jim locals were originally proposed by Miguel Sofer, I (SS) added
21	21	the feature that make they similar to lexical scoped closures
22	22	using capturing of the local variables value if no explicit
23		intialization is provided.
	23	initialization is provided.
24	24
25	25	- The [lmap] command is my (SS) design, but I incorporated inside the
26	26	command an interesting idea of Donal K. Fellows that proposed that
27	27	the [continue] command may be used to skip the accumulation of the
28		current-iteartion result, providing in one command the power of
	28	current-iteration result, providing in one command the power of
29	29	[map] and [filter] together.
30	30
31	31

-4

DEVELOPING less more

45	45	taken care of is the project mode -- it should be "push mode".
46	46
47	47	Once the project is created one must add a user that will actually
48		start commiting new files to the repo. It can also be done through the
	48	start committing new files to the repo. It can also be done through the
49	49	WWW interface, so nothing more is necessary.
50	50
51	51	Once finished with setting up a project on the WWW panel, one can

64	64
65	65	In order to add file we type "git add <file>". For remove, we do "git rm
66	66	<file>". To remove all local changes that aren't in a repository you do "git
67		reset --hard HEAD". Once inserted, files have to be commited with "git commit
	67	reset --hard HEAD". Once inserted, files have to be committed with "git commit
68	68	-a". Once done with commits for today, "git push" can be used to propagate
69	69	changes from your local disk to the remote repository.
70	70
71	71	Right now you can verify whether this works by trying to clone your
72		project's repository somewhere else, this time using anonymount HTTP
	72	project's repository somewhere else, this time using anonymous HTTP
73	73	access:
74	74
75	75	git clone http://repo.or.cz/r/jimtcl/wkoszek.git

82	82
83	83	http://jim.tcl.tk:8080/cgi-bin/mailman/listinfo/jim-devel
84	84
85		Patches prepared with the procedures presented abore are welcome. Before
	85	Patches prepared with the procedures presented above are welcome. Before
86	86	submitting patches, you can verify that your changes didn't bring any
87	87	regressions to the Jim. In order to do so, sample regression tests have
88	88	been implemented. You can execute them by typing:

+30

-4

Makefile.in less more

18	18	RANLIB = @RANLIB@
19	19	AR = @AR@
20	20	STRIP = @STRIP@
	21	@if COVERAGE
	22	export CCACHE_DISABLE := 1
	23	@endif
21	24
22	25	# Configuration
23	26

40	43	exec_prefix ?= @exec_prefix@
41	44	prefix ?= @prefix@
42	45	docdir = @docdir@
	46	srcdir := @srcdir@
43	47
44	48	CC += -Wall $(OPTIM) -I.
45	49	CXX += -Wall $(OPTIM) -I.

112	116	install-exec: all
113	117	$(INSTALL_DATA_DIR) $(DESTDIR)@bindir@
114	118	$(INSTALL_PROGRAM) $(JIMSH) $(DESTDIR)@bindir@
	119	$(INSTALL_PROGRAM) @srcdir@/jimdb $(DESTDIR)@bindir@
115	120
116	121	uninstall:
117	122	rm -f $(DESTDIR)@bindir@/$(JIMSH)

126	131	@endif
127	132
128	133	test check: $(JIMSH)
129		cd @srcdir@/tests; $(DEF_LD_PATH) $(MAKE) jimsh=@builddir@/jimsh TOPSRCDIR=..
	134	$(DEF_LD_PATH) $(MAKE) -C tests jimsh="@builddir@/jimsh"
130	135
131	136	$(OBJS) jimsh.o initjimsh.o: Makefile $(wildcard *.h)
132	137

176	181
177	182	Tcl.html: jim_tcl.txt @srcdir@/make-index
178	183	@if HAVE_ASCIIDOC
179		@tclsh@ @srcdir@/make-index $> $^ \| @ASCIIDOC@ -d manpage -a footer-style=none - \| @SED@ -e '/^<div.*id="footer-text"/,/<\/div>/d' >$@
	184	@tclsh@ @srcdir@/make-index $> $^ \| @ASCIIDOC@ --attribute footer-style=none -d manpage - >$@
180	185	@else
181	186	@echo "asciidoc is not available"; false
	187	@endif
	188
	189	coverage:
	190	@if COVERAGE
	191	@if COVERAGE_TOOL eq "lcov"
	192	@LCOV@ -c --rc genhtml_branch_coverage=1 -d . -o lcov.txt
	193	@GENHTML@ --rc genhtml_branch_coverage=1 -o coverage_html lcov.txt > genhtml_output.txt
	194	@LCOV@ --summary lcov.txt
	195	@endif
	196	@if COVERAGE_TOOL eq "gcovr"
	197	@GCOVR@ -s -e 'conftest*' --html --html-details --output coverage.html
	198	@endif
	199	@if COVERAGE_TOOL eq "gcov"
	200	gcov @srcdir@/*.c
	201	@endif
	202	@else
	203	@echo "Use ./configure --coverage to enable code coverage"
182	204	@endif
183	205
184	206	clean:
185	207	rm -f .o .so .dll .exe lib.a $(JIMSH) $(LIBJIM) Tcl.html _.c
	208	@if COVERAGE
	209	rm -f .gcno .gcov .gcda /.gcno /.gcda /.gcov coverage.html
	210	rm -rf coverage_html lcov.txt genhtml_output.txt
	211	@endif
186	212
187	213	distclean: clean
188		rm -f jimautoconf.h jim-config.h Makefile config.log @srcdir@/autosetup/jimsh0@EXEEXT@ build-jim-ext
189		rm -f jimtcl.pc tests/Makefile
	214	rm -f jimautoconf.h jim-config.h Makefile config.log jimsh0@EXEEXT@ build-jim-ext
	215	rm -f jimtcl.pc tests/Makefile examples.api/Makefile
190	216
191	217	ship: Tcl.html
192	218	cp $< Tcl_shipped.html

-1

README less more

189	189	"first Jim goal: to vent my need to hack on Tcl."
190	190
191	191	And actually this is exactly why I started Jim, in the first days
192		of Jenuary 2005. After a month of hacking Jim was able to run
	192	of January 2005. After a month of hacking Jim was able to run
193	193	simple scripts, now, after two months it started to be clear to
194	194	me that it was not just the next toy to throw away but something
195	195	that may evolve into a real interpreter. In the same time

-3

README.metakit less more

38	38	CREATING VIEWS
39	39	--------------
40	40	Views in Metakit are what is called "tables" in conventional databases. A view
41		may several typed properties, or columns, and contains homogenous rows, or
	41	may several typed properties, or columns, and contains homogeneous rows, or
42	42	records. New properties may be added to a view as needed; however, new properties
43	43	are not stored in the database file by default. The structure method specifies
44	44	the stored properties of a view, creating a new view or restructuring an old one

73	73	`subview`
74	74	: This type is not usually specified directly; instead, a structure
75	75	description of a nested view is given. `subview` properties store complete
76		views as their value, creating hierarchical data structures. When retreived
	76	views as their value, creating hierarchical data structures. When retrieved
77	77	from a view, a value of a subview property is a normal view handle.
78	78
79	79	Without a `description` parameter, the `structure` method returns the current

107	107	and may also be specified relative to the last row of the view using the
108	108	`end[+-]integer` notation.
109	109
110		A dictionary containing all property name and value pairs can be retreived by
	110	A dictionary containing all property name and value pairs can be retrieved by
111	111	omitting the `propName` argument:
112	112
113	113	cursor get $cur

+105

-0

README.redis less more

	0	Jim redis extension documentation.
	1
	2	Overview
	3	~~~~~~~~
	4
	5	The redis extension is a very simple extension to provide fast
	6	client access to redis (https://redis.io/) via the hiredis library
	7	(which must be available when building).
	8
	9	Usage
	10	~~~~~
	11
	12	The redis extension exports an Object Based interface. In order
	13	to open a connection, a stream sock must be open to the redis server.
	14	e.g.
	15
	16	set r [redis [socket stream localhost:6379]]
	17
	18	Or to connect via the unix domain socket:
	19
	20	set r [redis [socket unix /tmp/redis.sock]]
	21
	22	The [redis] command returns a handle, that is a command name that
	23	can be used to perform operations on the redis instance. A real example:
	24
	25	. package require redis
	26	1.0
	27	. set r [redis [socket stream localhost:6379]]
	28	::redis.handle4
	29	. $r KEYS a*
	30	abc
	31	. $r SET def 3
	32	OK
	33	. $r INCR def
	34	4
	35	. $r HMSET hash a 1 b 2 c 3
	36	OK
	37	. $r HGETALL hash
	38	a 1 b 2 c 3
	39
	40	Note that redis commands are shown here in uppercase, but they are accepted in
	41	a case insensitive manner.
	42
	43	The redis connection is very thin wrapper around the redis protocol.
	44	It simply formats the command according the redis protocol and converts
	45	the response into the appropriate Tcl format.
	46
	47	Note that all values are binary strings, so keys and values in utf-8
	48	format will be stored and returned exactly.
	49
	50	Return values
	51	~~~~~~~~~~~~~
	52
	53	The response from redis contains a type, and these types are handled as follows:
	54
	55	* integer - returns the integer result
	56	* string - returns the string result
	57	* array - returns a list of elements (where each element is a redis type)
	58	* null - returns the empty string
	59	* status - returns the status as a string
	60	* error - returns an error with the message as the value
	61
	62	The read subcommand
	63	~~~~~~~~~~~~~~~~~~~
	64
	65	While most redis commands return an immediate response, SUBSRIBE and PSUBSCRIBE
	66	return multiple results over time. These responses can be (synchronously)
	67	read with the 'read' subcommand, typically in conjunction with readable.
	68
	69	For example
	70
	71	. $r SUBSCRIBE chan
	72	subscribe chan 1
	73	. $r read
	74	message chan PONG
	75
	76	If no message is received, the read command will wait forever.
	77
	78	The message is returned as: message <channel> <text>
	79
	80	The readable subcommand
	81	~~~~~~~~~~~~~~~~~~~~~~~
	82
	83	Like normal aio sockets, the readable subcommand is supported to invoke
	84	the given script when the underlying socket is readable.
	85
	86	$r SUBSCRIBE channel
	87	$r readable {
	88	puts [$r read]
	89	}
	90	# wait forever, reading messages from the channel
	91	vwait forever
	92
	93	To remove the callback, invoke with no arguments (this is different from aio readable).
	94
	95	# Remove the callback
	96	$r readable
	97
	98	The close subcommand
	99	~~~~~~~~~~~~~~~~~~~~
	100
	101	The 'close' command is supported to close the connection.
	102	This command is equivalent to deleting the command with:
	103
	104	rename $r ""

-1

README.utf-8 less more

31	31	Unicode into bytes. Thus the Unicode codepoint U+00B5 is encoded
32	32	in UTF-8 with the byte sequence: 0xc2, 0xb5. This is different from
33	33	ASCII where the same name is used interchangeably between a character value
34		and and its encoding.
	34	and its encoding.
35	35
36	36	Unicode Escapes
37	37	---------------

+598

-183

Tcl_shipped.html less more

738	738	</h1>
739	739	<h2>NAME</h2>
740	740	<div class="sectionbody">
741		<p>Jim Tcl v0.79 -
	741	<p>Jim Tcl v0.81 -
742	742	reference manual for the Jim Tcl scripting language
743	743	</p>
744	744	</div>

790	790	The core language engine is compatible with Tcl 8.5+, while implementing
791	791	a significant subset of the Tcl 8.6 command set, plus additional features
792	792	available only in Jim Tcl.</p></div>
793		<div class="paragraph"><p>Some notable differences with Tcl 8.5/8.6 are:</p></div>
	793	<div class="paragraph"><p>Some notable differences with Tcl 8.5/8.6/8.7 are:</p></div>
794	794	<div class="olist arabic"><ol class="arabic">
795	795	<li>
796	796	<p>

878	878	<div class="sect1">
879	879	<h2 id="_recent_changes">RECENT CHANGES</h2>
880	880	<div class="sectionbody">
	881	<div class="sect2">
	882	<h3 id="_changes_between_0_80_and_0_81">Changes between 0.80 and 0.81</h3>
	883	<div class="olist arabic"><ol class="arabic">
	884	<li>
	885	<p>
	886	TIP 582, comments allowed in expressions
	887	</p>
	888	</li>
	889	<li>
	890	<p>
	891	Many commands now accept "safe" integer expressions rather than simple integers:
	892	<a href="#_loop"><strong><code>loop</code></strong></a>, <a href="#_range"><strong><code>range</code></strong></a>, <a href="#_incr"><strong><code>incr</code></strong></a>, <a href="#_string"><strong><code>string</code></strong></a> <code>repeat</code>, <a href="#_lrepeat"><strong><code>lrepeat</code></strong></a>, <a href="#cmd_3"><strong><code>pack</code></strong></a>, <a href="#cmd_3"><strong><code>unpack</code></strong></a>, <a href="#_rand"><strong><code>rand</code></strong></a>
	893	</p>
	894	</li>
	895	<li>
	896	<p>
	897	String and list indexes now accept integer expressions (<a href="#_string_and_list_index_specifications">STRING AND LIST INDEX SPECIFICATIONS</a>)
	898	</p>
	899	</li>
	900	<li>
	901	<p>
	902	<a href="#_loop"><strong><code>loop</code></strong></a> can now omit the start value
	903	</p>
	904	</li>
	905	<li>
	906	<p>
	907	Add the <a href="#_xtrace"><strong><code>xtrace</code></strong></a> command for execution trace support
	908	</p>
	909	</li>
	910	<li>
	911	<p>
	912	Add <a href="#_history"><strong><code>history</code></strong></a> <code>keep</code>
	913	</p>
	914	</li>
	915	<li>
	916	<p>
	917	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
	918	</p>
	919	</li>
	920	<li>
	921	<p>
	922	<a href="#_lsort"><strong><code>lsort</code></strong></a> <code>-index</code> now supports multiple indices
	923	</p>
	924	</li>
	925	<li>
	926	<p>
	927	Add support for <a href="#_lsort"><strong><code>lsort</code></strong></a> <code>-stride</code>
	928	</p>
	929	</li>
	930	<li>
	931	<p>
	932	<a href="#_open"><strong><code>open</code></strong></a> now supports POSIX-style access arguments
	933	</p>
	934	</li>
	935	<li>
	936	<p>
	937	TIP 526, <a href="#_expr"><strong><code>expr</code></strong></a> now only allows a single argument (unless --compat is enabled)
	938	</p>
	939	</li>
	940	</ol></div>
	941	</div>
	942	<div class="sect2">
	943	<h3 id="_changes_between_0_79_and_0_80">Changes between 0.79 and 0.80</h3>
	944	<div class="olist arabic"><ol class="arabic">
	945	<li>
	946	<p>
	947	<a href="#_regsub"><strong><code>regsub</code></strong></a> now fully supports <code>\A</code>
	948	</p>
	949	</li>
	950	<li>
	951	<p>
	952	Add <a href="#_socket"><strong><code>socket</code></strong></a> <code>pty</code> to create a pseudo-tty pair
	953	</p>
	954	</li>
	955	<li>
	956	<p>
	957	Null characters (\x00) are now supported in variable and proc names
	958	</p>
	959	</li>
	960	<li>
	961	<p>
	962	dictionaries and arrays now preserve insertion order, matching Tcl and the documentation
	963	</p>
	964	</li>
	965	<li>
	966	<p>
	967	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
	968	</p>
	969	</li>
	970	<li>
	971	<p>
	972	Add string comparison operators (lt, gt, le, ge) per TIP 461
	973	</p>
	974	</li>
	975	<li>
	976	<p>
	977	Implement 0d radix prefix for decimal per TIP 472
	978	</p>
	979	</li>
	980	</ol></div>
	981	</div>
881	982	<div class="sect2">
882	983	<h3 id="_changes_between_0_78_and_0_79">Changes between 0.78 and 0.79</h3>
883	984	<div class="olist arabic"><ol class="arabic">

1712	1813	</dt>
1713	1814	<dd>
1714	1815	<p>
1715		A simple integer, where <em>0</em> refers to the first element of the string
	1816	A simple integer, where <code>0</code> refers to the first element of the string
1716	1817	or list.
1717	1818	</p>
1718	1819	</dd>
1719	1820	<dt class="hdlist1">
1720		<code>integer+integer</code> or
1721		</dt>
1722		<dt class="hdlist1">
1723		<code>integer-integer</code>
1724		</dt>
1725		<dd>
1726		<p>
1727		The sum or difference of the two integers. e.g. <code>2+3</code> refers to the 5th element.
1728		This is useful when used with (e.g.) <code>$i+1</code> rather than the more verbose
1729		<code>[expr {$i+1}]</code>
1730		</p>
1731		</dd>
1732		<dt class="hdlist1">
1733		<code>end</code>
	1821	<code>integerexpression</code>
	1822	</dt>
	1823	<dd>
	1824	<p>
	1825	Any "safe" expression that evaluates to an integer. A "safe" expression does not perform
	1826	variable or command subsitution, but is otherwise like a normal expression
	1827	(see <a href="#_expressions">EXPRESSIONS</a>).
	1828	</p>
	1829	</dd>
	1830	<dt class="hdlist1">
	1831
	1832	</dt>
	1833	<dd>
	1834	<p>
	1835	For example <code>1+23</code> is valid integer expression, but <code>{$x2-1}</code> is not.
	1836	But note that it is possible to use an unbraced expression to allow the Tcl interpreter
	1837	to expand variables and commands before being parsed as an integer expression.
	1838	</p>
	1839	</dd>
	1840	<dt class="hdlist1">
	1841
	1842	</dt>
	1843	<dd>
	1844	<p>
	1845	e.g. <code>string repeat a $x*2-1</code>
	1846	</p>
	1847	</dd>
	1848	<dt class="hdlist1">
	1849	<code><strong>end</strong></code>
1734	1850	</dt>
1735	1851	<dd>
1736	1852	<p>

1738	1854	</p>
1739	1855	</dd>
1740	1856	<dt class="hdlist1">
1741		<code>end-integer</code>
1742		</dt>
1743		<dd>
1744		<p>
1745		The <em>nth-from-last</em> element of the string or list.
	1857	<code><strong>end</strong>-integer</code>
	1858	</dt>
	1859	<dt class="hdlist1">
	1860	<code><strong>end</strong>-integerexpression</code>
	1861	</dt>
	1862	<dt class="hdlist1">
	1863	<code><strong>end</strong>+integerexpression</code>
	1864	</dt>
	1865	<dd>
	1866	<p>
	1867	The <em>nth-from-last</em> element of the string or list. Again, a "safe" integer expression
	1868	may be used in place of a simple integer. <code>end-3</code> or <code>end-3+2*$n</code>. Normally it only makes
	1869	sense to use the <code><strong>end</strong>-</code> form, but if the integer expression is negative, the <code><strong>end</strong></code>+ form
	1870	may be used.
1746	1871	</p>
1747	1872	</dd>
1748	1873	</dl></div>

1841	1966	<div class="paragraph"><p>White space may be used between the operands and operators and
1842	1967	parentheses; it is ignored by the expression processor.
1843	1968	Where possible, operands are interpreted as integer values.</p></div>
1844		<div class="paragraph"><p>Integer values may be specified in decimal (the normal case) or in
1845		hexadecimal (if the first two characters of the operand are <em>0x</em>).
1846		Note that Jim Tcl does <strong>not</strong> treat numbers with leading zeros as octal.</p></div>
	1969	<div class="paragraph"><p>Comments are allowed in expressions, beginning with the <em>#</em> character
	1970	and continuing until the end of line or end of expression.</p></div>
	1971	<div class="paragraph"><p>Integer values are interpreted as decimal, binary, octal or
	1972	hexadecimal if prepended with <em>0d</em>, <em>0b</em>, <em>0o</em> or <em>0x</em>
	1973	respectively. Otherwise they are interpreted as decimal by default.
	1974	(Jim Tcl does not interpret numbers with leading zeros as octal.)</p></div>
1847	1975	<div class="paragraph"><p>If an operand does not have one of the integer formats given
1848	1976	above, then it is treated as a floating-point number if that is
1849	1977	possible. Floating-point numbers may be specified in any of the

2028	2156	Each operator produces 1 if the condition is true, 0 otherwise.
2029	2157	These operators may be applied to strings as well as numeric operands,
2030	2158	in which case string comparison is used.
	2159	</p>
	2160	</dd>
	2161	<dt class="hdlist1">
	2162	<code>lt gt le ge</code>
	2163	</dt>
	2164	<dd>
	2165	<p>
	2166	Boolean less, greater, less than or equal, and greater than or equal.
	2167	Each operator produces 1 if the condition is true, 0 otherwise.
	2168	These operators differ from the above in that they use string comparison
	2169	for all operands, including numeric.
2031	2170	</p>
2032	2171	</dd>
2033	2172	<dt class="hdlist1">

2287	2426	<div class="sect1">
2288	2427	<h2 id="_regular_expressions">REGULAR EXPRESSIONS</h2>
2289	2428	<div class="sectionbody">
2290		<div class="paragraph"><p>Tcl provides two commands that support string matching using regular
	2429	<div class="paragraph"><p>Jim Tcl provides two commands that support string matching using regular
2291	2430	expressions, <a href="#_regexp"><strong><code>regexp</code></strong></a> and <a href="#_regsub"><strong><code>regsub</code></strong></a>, as well as <a href="#_switch"><strong><code>switch</code></strong></a> <code>-regexp</code> and
2292	2431	<a href="#_lsearch"><strong><code>lsearch</code></strong></a> <code>-regexp</code>.</p></div>
2293	2432	<div class="paragraph"><p>Regular expressions may be implemented one of two ways. Either using the system’s C library

2335	2474	</li>
2336	2475	<li>
2337	2476	<p>
2338		Supported constraint escapes: <code>\m</code> = <code>\<</code> = start of word, <code>\M</code> = <code>\></code> = end of word
	2477	Supported constraint escapes: <code>\m</code> = <code>\<</code> = start of word, <code>\M</code> = <code>\></code> = end of word, <code>\A</code> = start of string, <code>\Z</code> = end of string
2339	2478	</p>
2340	2479	</li>
2341	2480	<li>

2345	2484	</li>
2346	2485	<li>
2347	2486	<p>
2348		Partially supported constraint escapes: <code>\A</code> = start of string, <code>\Z</code> = end of string
2349		</p>
2350		</li>
2351		<li>
2352		<p>
2353	2487	Support for the <code>?</code> non-greedy quantifier. e.g. <code>*?</code>
2354	2488	</p>
2355	2489	</li>

2363	2497	Jim Tcl considers that both patterns and strings end at a null character (<code>\x00</code>)
2364	2498	</p>
2365	2499	</li>
	2500	<li>
	2501	<p>
	2502	Jim Tcl does not support back references. e.g. <code>\1</code>
	2503	</p>
	2504	</li>
2366	2505	</ol></div>
2367	2506	</div>
	2507	</div>
	2508	</div>
	2509	<div class="sect1">
	2510	<h2 id="_string_matching">STRING MATCHING</h2>
	2511	<div class="sectionbody">
	2512	<div class="paragraph"><p>A number of commands in Jim support C-shell style "glob matching", including
	2513	<a href="#_string"><strong><code>string</code></strong></a> <code>match</code>, <a href="#_switch"><strong><code>switch</code></strong></a> <code>-glob</code>, <a href="#_array"><strong><code>array</code></strong></a> <code>names</code> and others. This form of string matching
	2514	works as follows:</p></div>
	2515	<div class="paragraph"><p>A test occurs where a <code><em>string</em></code> is matched against a <code><em>pattern</em></code>. The match is considered
	2516	successful if the contents of <code><em>string</em></code> and <code><em>pattern</em></code> are identical except that the
	2517	following special sequences may appear in <code><em>pattern</em></code>:</p></div>
	2518	<div class="dlist"><dl>
	2519	<dt class="hdlist1">
	2520	<code>*</code>
	2521	</dt>
	2522	<dd>
	2523	<p>
	2524	Matches any sequence of characters in <code><em>string</em></code>, including an empty string.
	2525	</p>
	2526	</dd>
	2527	<dt class="hdlist1">
	2528	<code>?</code>
	2529	</dt>
	2530	<dd>
	2531	<p>
	2532	Matches any single character in <code><em>string</em></code>.
	2533	</p>
	2534	</dd>
	2535	<dt class="hdlist1">
	2536	<code>[<em>chars</em>]</code>
	2537	</dt>
	2538	<dd>
	2539	<p>
	2540	Matches any character in the set given by <code><em>chars</em></code>.
	2541	If a sequence of the form <code><em>x-y</em></code> appears in <code><em>chars</em></code>,
	2542	then any character between <code><em>x</em></code> and <code><em>y</em></code>, inclusive,
	2543	will match.
	2544	</p>
	2545	</dd>
	2546	<dt class="hdlist1">
	2547	<code>\x</code>
	2548	</dt>
	2549	<dd>
	2550	<p>
	2551	Matches the single character <code><em>x</em></code>. This provides a way of
	2552	avoiding the special interpretation of the characters <code>\*?[]</code>
	2553	in <code><em>pattern</em></code>.
	2554	</p>
	2555	</dd>
	2556	</dl></div>
2368	2557	</div>
2369	2558	</div>
2370	2559	<div class="sect1">

2935	3124	is still available to embed UTF-8 sequences.</p></div>
2936	3125	<div class="paragraph"><p>Jim Tcl supports all currently defined unicode codepoints. That is 21 bits, up to +<em>U+1FFFFF</em>.</p></div>
2937	3126	<div class="sect2">
2938		<h3 id="_string_matching">String Matching</h3>
2939		<div class="paragraph"><p>Commands such as <a href="#_string"><strong><code>string</code></strong></a> <code>match</code>, <a href="#_lsearch"><strong><code>lsearch</code></strong></a> <code>-glob</code>, <a href="#_array"><strong><code>array</code></strong></a> <code>names</code> and others use string
2940		pattern matching rules. These commands support UTF-8. For example:</p></div>
	3127	<h3 id="_string_matching_2">String Matching</h3>
	3128	<div class="paragraph"><p>Commands such as <a href="#_string"><strong><code>string</code></strong></a> <code>match</code>, <a href="#_lsearch"><strong><code>lsearch</code></strong></a> <code>-glob</code>, <a href="#_array"><strong><code>array</code></strong></a> <code>names</code> and others use
	3129	<a href="#_string_matching">STRING MATCHING</a> rules. These commands support UTF-8. For example:</p></div>
2941	3130	<div class="listingblock">
2942	3131	<div class="content">
2943	3132	<pre><code> string match a\[\ua0-\ubf\]b "a\u00a3b"</code></pre>

3195	3384	<td align="left" valign="top"><p class="table"><a href="#cmd_2"><strong><code>vwait</code></strong></a></p></td>
3196	3385	<td align="left" valign="top"><p class="table"><a href="#_wait"><strong><code>wait</code></strong></a></p></td>
3197	3386	<td align="left" valign="top"><p class="table"><a href="#_while"><strong><code>while</code></strong></a></p></td>
	3387	<td align="left" valign="top"><p class="table"><a href="#_xtrace"><strong><code>xtrace</code></strong></a></p></td>
3198	3388	<td align="left" valign="top"><p class="table"><a href="#_zlib"><strong><code>zlib</code></strong></a></p></td>
3199		<td align="left" valign="top"><p class="table"></p></td>
3200	3389	</tr>
3201	3390	</tbody>
3202	3391	</table>

3243	3432	<h3 id="_apply">apply</h3>
3244	3433	<div class="paragraph"><p><code><strong>apply</strong> <em>lambdaExpr ?arg1 arg2 ...?</em></code></p></div>
3245	3434	<div class="paragraph"><p>The command <a href="#_apply"><strong><code>apply</code></strong></a> provides for anonymous procedure calls,
3246		similar to <a href="#_lambda"><strong><code>lambda</code></strong></a>, but without command name being created, even temporarily.</p></div>
3247		<div class="paragraph"><p>The function <code><em>lambdaExpr</em></code> is a two element list <code>{args body}</code>
3248		or a three element list <code>{args body namespace}</code>. The first element
3249		args specifies the formal arguments, in the same form as the <a href="#_proc"><strong><code>proc</code></strong></a> and <a href="#_lambda"><strong><code>lambda</code></strong></a> commands.</p></div>
	3435	similar to <a href="#_lambda"><strong><code>lambda</code></strong></a>, but without a command name being created, even temporarily.</p></div>
	3436	<div class="paragraph"><p>The function <code><em>lambdaExpr</em></code> is a two element list, <code>{args body}</code>
	3437	or a three element list, <code>{args body namespace}</code>. The first element
	3438	<code><em>args</em></code> specifies the formal arguments in the same form as the <a href="#_proc"><strong><code>proc</code></strong></a> and <a href="#_lambda"><strong><code>lambda</code></strong></a> commands.</p></div>
3250	3439	</div>
3251	3440	<div class="sect2">
3252	3441	<h3 id="_array">array</h3>

3263	3452	</dt>
3264	3453	<dd>
3265	3454	<p>
3266		Returns 1 if arrayName is an array variable, 0 if there is
	3455	Returns 1 if <code><em>arrayName</em></code> is an array variable, 0 if there is
3267	3456	no variable by that name.
3268	3457	</p>
3269	3458	</dd>

3273	3462	<dd>
3274	3463	<p>
3275	3464	Returns a list containing pairs of elements. The first
3276		element in each pair is the name of an element in arrayName
	3465	element in each pair is the name of an element in <code><em>arrayName</em></code>
3277	3466	and the second element of each pair is the value of the
3278	3467	array element. The order of the pairs is undefined. If
3279		pattern is not specified, then all of the elements of the
3280		array are included in the result. If pattern is specified,
3281		then only those elements whose names match pattern (using
3282		the matching rules of string match) are included. If arrayName
	3468	<code><em>pattern</em></code> is not specified, then all of the elements of the
	3469	array are included in the result. If <code><em>pattern</em></code> is specified,
	3470	then only those elements whose names match <code><em>pattern</em></code> (using
	3471	<a href="#_string_matching">STRING MATCHING</a> rules) are included. If <code><em>arrayName</em></code>
3283	3472	isn’t the name of an array variable, or if the array contains
3284	3473	no elements, then an empty list is returned.
3285	3474	</p>

3290	3479	<dd>
3291	3480	<p>
3292	3481	Returns a list containing the names of all of the elements
3293		in the array that match pattern. If pattern is omitted then
	3482	in the array that match <code><em>pattern</em></code>. If <code><em>pattern</em></code> is omitted then
3294	3483	the command returns all of the element names in the array.
3295		If pattern is specified, then only those elements whose
3296		names match pattern (using the matching rules of string
3297		match) are included. If there are no (matching) elements
3298		in the array, or if arrayName isn’t the name of an array
	3484	If <code><em>pattern</em></code> is specified, then only those elements whose
	3485	names match <code><em>pattern</em></code> (using <a href="#_string_matching">STRING MATCHING</a> rules)
	3486	are included. If there are no (matching) elements
	3487	in the array, or if <code><em>arrayName</em></code> isn’t the name of an array
3299	3488	variable, then an empty string is returned.
3300	3489	</p>
3301	3490	</dd>

3304	3493	</dt>
3305	3494	<dd>
3306	3495	<p>
3307		Sets the values of one or more elements in arrayName. list
	3496	Sets the values of one or more elements in <code><em>arrayName</em></code>. <code><em>list</em></code>
3308	3497	must have a form like that returned by array get, consisting
3309	3498	of an even number of elements. Each odd-numbered element
3310	3499	in list is treated as an element name within arrayName, and
3311	3500	the following element in list is used as a new value for
3312		that array element. If the variable arrayName does not
3313		already exist and list is empty, arrayName is created with
	3501	that array element. If the variable <code><em>arrayName</em></code> does not
	3502	already exist and list is empty, <code><em>arrayName</em></code> is created with
3314	3503	an empty array value.
3315	3504	</p>
3316	3505	</dd>

3319	3508	</dt>
3320	3509	<dd>
3321	3510	<p>
3322		Returns the number of elements in the array. If arrayName
	3511	Returns the number of elements in the array. If <code><em>arrayName</em></code>
3323	3512	isn’t the name of an array then 0 is returned.
3324	3513	</p>
3325	3514	</dd>

3328	3517	</dt>
3329	3518	<dd>
3330	3519	<p>
3331		Unsets all of the elements in the array that match pattern
3332		(using the matching rules of string match). If arrayName
	3520	Unsets all of the elements in the array that match <code><em>pattern</em></code>
	3521	(using <a href="#_string_matching">STRING MATCHING</a> rules). If <code><em>arrayName</em></code>
3333	3522	isn’t the name of an array variable or there are no matching
3334		elements in the array, no error will be raised. If pattern
3335		is omitted and arrayName is an array variable, then the
	3523	elements in the array, no error will be raised. If <code><em>pattern</em></code>
	3524	is omitted and <code><em>arrayName</em></code> is an array variable, then the
3336	3525	command unsets the entire array. The command always returns
3337	3526	an empty string.
3338	3527	</p>

3458	3647	<dd>
3459	3648	<p>
3460	3649	If <code><em>boolean</em></code> is true, processing is performed in UTC.
3461		If <code><em>boolean</em></code> is false (the default), processing is performeed in the local time zone.
	3650	If <code><em>boolean</em></code> is false (the default), processing is performed in the local time zone.
3462	3651	</p>
3463	3652	</dd>
3464	3653	<dt class="hdlist1">

3472	3661	</p>
3473	3662	</dd>
3474	3663	</dl></div>
	3664	<div class="paragraph"><p><strong>NOTE</strong> Some systems such as 32-bit Linux have only a 32-bit time_t, and are therefore not year 2038
	3665	compliant.</p></div>
3475	3666	</div>
3476	3667	<div class="sect2">
3477	3668	<h3 id="_close">close</h3>

3578	3769	</p>
3579	3770	</dd>
3580	3771	<dt class="hdlist1">
	3772	<code><strong>dict getdef</strong> <em>dictionary ?key ...? key default</em></code>
	3773	</dt>
	3774	<dd>
	3775	<p>
	3776	Alias for <a href="#_dict"><strong><code>dict</code></strong></a> <code>getwithdefault</code>.
	3777	</p>
	3778	</dd>
	3779	<dt class="hdlist1">
	3780	<code><strong>dict getwithdefault</strong> <em>dictionary ?key ...? key default</em></code>
	3781	</dt>
	3782	<dd>
	3783	<p>
	3784	Similar to <a href="#_dict"><strong><code>dict</code></strong></a> <code>get</code> except if no value exists in the dictionary for the
	3785	give key(s), returns <code><em>default</em></code> instead.
	3786	</p>
	3787	</dd>
	3788	<dt class="hdlist1">
3581	3789	<code><strong>dict keys</strong> <em>dictionary ?pattern?</em></code>
3582	3790	</dt>
3583	3791	<dd>
3584	3792	<p>
3585	3793	Returns a list of the keys in the dictionary.
3586		If pattern is specified, then only those keys whose
3587		names match <code><em>pattern</em></code> (using the matching rules of string
3588		match) are included.
	3794	If <code><em>pattern</em></code> is specified, then only those keys whose
	3795	names match <code><em>pattern</em></code> (using <a href="#_string_matching">STRING MATCHING</a> rules)
	3796	are included.
3589	3797	</p>
3590	3798	</dd>
3591	3799	<dt class="hdlist1">

4446	4654	<div class="paragraph"><p>Increment the value stored in the variable whose name is <code><em>varName</em></code>.
4447	4655	The value of the variable must be integral.</p></div>
4448	4656	<div class="paragraph"><p>If <code><em>increment</em></code> is supplied then its value (which must be an
4449		integer) is added to the value of variable <code><em>varName</em></code>; otherwise
	4657	integer expression) is added to the value of variable <code><em>varName</em></code>; otherwise
4450	4658	1 is added to <code><em>varName</em></code>.</p></div>
4451	4659	<div class="paragraph"><p>The new value is stored as a decimal string in variable <code><em>varName</em></code>
4452	4660	and also returned as result.</p></div>

4510	4718	Tcl commands, including both the built-in commands written in C and
4511	4719	the command procedures defined using the <a href="#_proc"><strong><code>proc</code></strong></a> command.
4512	4720	If <code><em>pattern</em></code> is specified, only those names matching <code><em>pattern</em></code>
4513		are returned. Matching is determined using the same rules as for
4514		<a href="#_string"><strong><code>string</code></strong></a> <code>match</code>.
	4721	(using <a href="#_string_matching">STRING MATCHING</a> rules) are returned.
4515	4722	</p>
4516	4723	</dd>
4517	4724	<dt class="hdlist1">

4563	4770	If <code><em>pattern</em></code> isn’t specified, returns a list of all the names
4564	4771	of currently-defined global variables.
4565	4772	If <code><em>pattern</em></code> is specified, only those names matching <code><em>pattern</em></code>
4566		are returned. Matching is determined using the same rules as for
4567		<a href="#_string"><strong><code>string</code></strong></a> <code>match</code>.
	4773	(using <a href="#_string_matching">STRING MATCHING</a> rules) are returned.
4568	4774	</p>
4569	4775	</dd>
4570	4776	<dt class="hdlist1">

4602	4808	of currently-defined local variables, including arguments to the
4603	4809	current procedure, if any. Variables defined with the <a href="#_global"><strong><code>global</code></strong></a>
4604	4810	and <a href="#_upvar"><strong><code>upvar</code></strong></a> commands will not be returned. If <code><em>pattern</em></code> is
4605		specified, only those names matching <code><em>pattern</em></code> are returned.
4606		Matching is determined using the same rules as for <a href="#_string"><strong><code>string</code></strong></a> <code>match</code>.
	4811	specified, only those names matching <code><em>pattern</em></code>
	4812	(using <a href="#_string_matching">STRING MATCHING</a> rules) are returned.
4607	4813	</p>
4608	4814	</dd>
4609	4815	<dt class="hdlist1">

4624	4830	If <code><em>pattern</em></code> isn’t specified, returns a list of all the
4625	4831	names of Tcl command procedures.
4626	4832	If <code><em>pattern</em></code> is specified, only those names matching <code><em>pattern</em></code>
4627		are returned. Matching is determined using the same rules as for
4628		<a href="#_string"><strong><code>string</code></strong></a> <code>match</code>.
	4833	(using <a href="#_string_matching">STRING MATCHING</a> rules) are returned.
4629	4834	</p>
4630	4835	</dd>
4631	4836	<dt class="hdlist1">

4708	4913	returns a list of all the names of currently-visible variables, including
4709	4914	both locals and currently-visible globals.
4710	4915	If <code><em>pattern</em></code> is specified, only those names matching <code><em>pattern</em></code>
4711		are returned. Matching is determined using the same rules as for
4712		<a href="#_string"><strong><code>string</code></strong></a> <code>match</code>.
	4916	(using <a href="#_string_matching">STRING MATCHING</a> rules) are returned.
4713	4917	</p>
4714	4918	</dd>
4715	4919	</dl></div>

4807	5011	<h3 id="_local">local</h3>
4808	5012	<div class="paragraph"><p><code><strong>local</strong> <em>cmd ?arg...?</em></code></p></div>
4809	5013	<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
4810		be the name of an existing command, which is marked as having local scope.
	5014	be the name of an existing command, which is then marked as having local scope.
4811	5015	This means that when the current procedure exits, the specified
4812	5016	command is deleted. This can be useful with <a href="#_lambda"><strong><code>lambda</code></strong></a>, local procedures or
4813	5017	to automatically close a filehandle.</p></div>
4814		<div class="paragraph"><p>In addition, if a command already exists with the same name,
4815		the existing command will be kept rather than deleted, and may be called
	5018	<div class="paragraph"><p>In addition, if a the command already exists with the same name,
	5019	the existing command will be kept rather than being deleted, and may be called
4816	5020	via <a href="#_upcall"><strong><code>upcall</code></strong></a>. The previous command will be restored when the current
4817	5021	procedure exits. See <a href="#_upcall"><strong><code>upcall</code></strong></a> for more details.</p></div>
4818	5022	<div class="paragraph"><p>In this example, a local procedure is created. Note that the procedure

4844	5048	...
4845	5049	}</code></pre>
4846	5050	</div></div>
	5051	<div class="paragraph"><p>Also see <a href="#_defer"><strong><code>defer</code></strong></a> as another mechanism for cleaning up at the end of a procedure.</p></div>
4847	5052	</div>
4848	5053	<div class="sect2">
4849	5054	<h3 id="_loop">loop</h3>
4850		<div class="paragraph"><p><code><strong>loop</strong> <em>var first limit ?incr? body</em></code></p></div>
	5055	<div class="paragraph"><p><code><strong>loop</strong> <em>var ?first? limit ?incr? body</em></code></p></div>
4851	5056	<div class="paragraph"><p>Similar to <a href="#_for"><strong><code>for</code></strong></a> except simpler and possibly more efficient.
4852		With a positive increment, equivalent to:</p></div>
	5057	If <code><em>incr</em></code> is positive, the effect is, equivalent to:</p></div>
4853	5058	<div class="listingblock">
4854	5059	<div class="content">
4855	5060	<pre><code> for {set var $first} {$var < $limit} {incr var $incr} $body</code></pre>
4856	5061	</div></div>
4857		<div class="paragraph"><p>If <code><em>incr</em></code> is not specified, 1 is used.
	5062	<div class="paragraph"><p>While if <code><em>incr</em></code> is negative, the count is downwards.</p></div>
	5063	<div class="paragraph"><p>If <code><em>first</em></code> is not specified, 0 is used.
	5064	If <code><em>incr</em></code> is not specified, 1 is used.
4858	5065	Note that setting the loop variable inside the loop does not
4859	5066	affect the loop count.</p></div>
	5067	<div class="paragraph"><p><code><em>first</em></code>, <code><em>limit</em></code> and <code><em>incr</em></code> may be any integer expression.</p></div>
4860	5068	</div>
4861	5069	<div class="sect2">
4862	5070	<h3 id="_lindex">lindex</h3>

4917	5125	<div class="sect2">
4918	5126	<h3 id="_llength">llength</h3>
4919	5127	<div class="paragraph"><p><code><strong>llength</strong> <em>list</em></code></p></div>
4920		<div class="paragraph"><p>Treats <code><em>list</em></code> as a list and returns a decimal string giving
4921		the number of elements in it.</p></div>
	5128	<div class="paragraph"><p>Treats <code><em>list</em></code> as a list and returns the number of elements in that list.</p></div>
4922	5129	</div>
4923	5130	<div class="sect2">
4924	5131	<h3 id="_lset">lset</h3>

4927	5134	<div class="paragraph"><p>The <a href="#_lset"><strong><code>lset</code></strong></a> command accepts a parameter, <code><em>varName</em></code>, which it interprets
4928	5135	as the name of a variable containing a Tcl list. It also accepts
4929	5136	zero or more indices into the list. Finally, it accepts a new value
4930		for an element of varName. If no indices are presented, the command
	5137	for an element of <code><em>varName</em></code>. If no indices are presented, the command
4931	5138	takes the form:</p></div>
4932	5139	<div class="listingblock">
4933	5140	<div class="content">
4934	5141	<pre><code> lset varName newValue</code></pre>
4935	5142	</div></div>
4936	5143	<div class="paragraph"><p>In this case, newValue replaces the old value of the variable
4937		varName.</p></div>
	5144	<code><em>varName</em></code>.</p></div>
4938	5145	<div class="paragraph"><p>When presented with a single index, the <a href="#_lset"><strong><code>lset</code></strong></a> command
4939		treats the content of the varName variable as a Tcl list. It addresses
	5146	treats the content of the <code><em>varName</em></code> variable as a Tcl list. It addresses
4940	5147	the index’th element in it (0 refers to the first element of the
4941	5148	list). When interpreting the list, <a href="#_lset"><strong><code>lset</code></strong></a> observes the same rules
4942	5149	concerning braces and quotes and backslashes as the Tcl command
4943	5150	interpreter; however, variable substitution and command substitution
4944	5151	do not occur. The command constructs a new list in which the
4945	5152	designated element is replaced with newValue. This new list is
4946		stored in the variable varName, and is also the return value from
	5153	stored in the variable <code><em>varName</em></code>, and is also the return value from
4947	5154	the <a href="#_lset"><strong><code>lset</code></strong></a> command.</p></div>
4948	5155	<div class="paragraph"><p>If index is negative or greater than or equal to the number of
4949		elements in $varName, then an error occurs.</p></div>
	5156	elements in <code>$varName</code>, then an error occurs.</p></div>
4950	5157	<div class="paragraph"><p>See <a href="#_string_and_list_index_specifications">STRING AND LIST INDEX SPECIFICATIONS</a> for all allowed forms for <code><em>index</em></code>.</p></div>
4951	5158	<div class="paragraph"><p>If additional index arguments are supplied, then each argument is
4952	5159	used in turn to address an element within a sublist designated by

5067	5274	</dt>
5068	5275	<dd>
5069	5276	<p>
5070		<code><em>pattern</em></code> is a glob-style pattern which is matched against each list element using the same
5071		rules as the string match command.
	5277	<code><em>pattern</em></code> is a glob-style pattern which is matched against each list element using
	5278	<a href="#_string_matching">STRING MATCHING</a> rules.
5072	5279	</p>
5073	5280	</dd>
5074	5281	<dt class="hdlist1">

5077	5284	<dd>
5078	5285	<p>
5079	5286	<code><em>pattern</em></code> is treated as a regular expression and matched against each list element using
5080		the rules described by <a href="#_regexp"><strong><code>regexp</code></strong></a>.
	5287	<a href="#_regular_expressions">REGULAR EXPRESSIONS</a> rules.
5081	5288	</p>
5082	5289	</dd>
5083	5290	<dt class="hdlist1">

5141	5348	Causes comparisons to be handled in a case-insensitive manner.
5142	5349	</p>
5143	5350	</dd>
	5351	<dt class="hdlist1">
	5352	<code><strong>-index</strong> <em>indexList</em></code>
	5353	</dt>
	5354	<dd>
	5355	<p>
	5356	This option is designed for use when searching within nested lists. The
	5357	<em>indexList</em> gives a path of indices (much as might be used with
	5358	the lindex or lset commands) within each element to allow the location
	5359	of the term being matched against.
	5360	</p>
	5361	</dd>
	5362	<dt class="hdlist1">
	5363	<code><strong>-stride</strong> <em>strideLength</em></code>
	5364	</dt>
	5365	<dd>
	5366	<p>
	5367	If this option is specified, the list is treated as consisting of
	5368	groups of <em>strideLength</em> elements and the groups are searched by
	5369	either their first element or, if the <code>-index</code> option is used,
	5370	by the element within each group given by the first index passed to
	5371	<code>-index</code> (which is then ignored by <code>-index</code>). The resulting
	5372	index always points to the first element in a group.
	5373	</p>
	5374	</dd>
	5375	<dt class="hdlist1">
	5376
	5377	</dt>
	5378	<dd>
	5379	<p>
	5380	The list length must be an integer multiple of <em>strideLength</em>, which
	5381	in turn must be at least 1. A <em>strideLength</em> of 1 is the default and
	5382	indicates no grouping.
	5383	</p>
	5384	</dd>
5144	5385	</dl></div>
5145	5386	</div>
5146	5387	<div class="sect2">
5147	5388	<h3 id="_lsort">lsort</h3>
5148		<div class="paragraph"><p><code><strong>lsort</strong> ?<strong>-index</strong> <em>listindex</em>? ?<strong>-nocase\|-integer\|-real\|-command</strong> <em>cmdname</em>? ?<strong>-unique</strong>? ?<strong>-decreasing</strong>\|<strong>-increasing</strong>? <em>list</em></code></p></div>
	5389	<div class="paragraph"><p><code><strong>lsort</strong> <em>?options? list</em></code></p></div>
5149	5390	<div class="paragraph"><p>Sort the elements of <code><em>list</em></code>, returning a new list in sorted order.
5150	5391	By default, ASCII (or UTF-8) sorting is used, with the result in increasing order.</p></div>
5151		<div class="paragraph"><p>If <code>-nocase</code> is specified, comparisons are case-insensitive.</p></div>
5152		<div class="paragraph"><p>If <code>-integer</code> is specified, numeric sorting is used.</p></div>
5153		<div class="paragraph"><p>If <code>-real</code> is specified, floating point number sorting is used.</p></div>
5154		<div class="paragraph"><p>If <code>-command <em>cmdname</em></code> is specified, <code><em>cmdname</em></code> is treated as a command
5155		name. For each comparison, <code><em>cmdname $value1 $value2</code></em> is called which
5156		should compare the values and return an integer less than, equal
5157		to, or greater than zero if the <code><em>$value1</em></code> is to be considered less
5158		than, equal to, or greater than <code><em>$value2</em></code>, respectively.</p></div>
5159		<div class="paragraph"><p>If <code>-decreasing</code> is specified, the resulting list is in the opposite
5160		order to what it would be otherwise. <code>-increasing</code> is the default.</p></div>
5161		<div class="paragraph"><p>If <code>-unique</code> is specified, then only the last set of duplicate elements found in the list will be retained.
5162		Note that duplicates are determined relative to the comparison used in the sort. Thus if <code>-index 0</code> is used,
5163		<code>{1 a}</code> and <code>{1 b}</code> would be considered duplicates and only the second element, <code>{1 b}</code>, would be retained.</p></div>
5164		<div class="paragraph"><p>If <code>-index <em>listindex</em></code> is specified, each element of the list is treated as a list and
5165		the given index is extracted from the list for comparison. The list index may
5166		be any valid list index, such as <code>1</code>, <code>end</code> or <code>end-2</code>.</p></div>
	5392	<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>
	5393	with last option being used.</p></div>
	5394	<div class="dlist"><dl>
	5395	<dt class="hdlist1">
	5396	<code><strong>-integer</strong></code>
	5397	</dt>
	5398	<dd>
	5399	<p>
	5400	Sort using numeric (integer) comparison.
	5401	</p>
	5402	</dd>
	5403	<dt class="hdlist1">
	5404	<code><strong>-real</strong></code>
	5405	</dt>
	5406	<dd>
	5407	<p>
	5408	Sort using floating point comparison.
	5409	</p>
	5410	</dd>
	5411	<dt class="hdlist1">
	5412	<code><strong>-nocase</strong></code>
	5413	</dt>
	5414	<dd>
	5415	<p>
	5416	Sort using using string comparison without regard for case.
	5417	</p>
	5418	</dd>
	5419	<dt class="hdlist1">
	5420	<code><strong>-command</strong> <em>cmdname</em></code>
	5421	</dt>
	5422	<dd>
	5423	<p>
	5424	<code><em>cmdname</em></code> is treated as a command name. For each comparison,
	5425	<code><em>cmdname $value1 $value2</code></em> is called which
	5426	should compare the values and return an integer less than, equal
	5427	to, or greater than zero if the <code><em>$value1</em></code> is to be considered less
	5428	than, equal to, or greater than <code><em>$value2</em></code>, respectively.
	5429	</p>
	5430	</dd>
	5431	<dt class="hdlist1">
	5432	<code><strong>-increasing</strong></code>
	5433	</dt>
	5434	<dd>
	5435	<p>
	5436	The resulting list is in ascending order, from smallest/lowest to largest/highest.
	5437	This is the default and does not need to be specified.
	5438	</p>
	5439	</dd>
	5440	<dt class="hdlist1">
	5441	<code><strong>-decreasing</strong></code>
	5442	</dt>
	5443	<dd>
	5444	<p>
	5445	The resulting list is in the opposite order to what it would be otherwise.
	5446	</p>
	5447	</dd>
	5448	<dt class="hdlist1">
	5449	<code><strong>-unique</strong></code>
	5450	</dt>
	5451	<dd>
	5452	<p>
	5453	Only the last set of duplicate elements found in the list will
	5454	be retained. Note that duplicates are determined relative to the
	5455	comparison used in the sort. Thus if <code>-index 0</code> is used, <code>{1 a}</code> and
	5456	<code>{1 b}</code> would be considered duplicates and only the second element,
	5457	<code>{1 b}</code>, would be retained.
	5458	</p>
	5459	</dd>
	5460	<dt class="hdlist1">
	5461	<code><strong>-index</strong> <em>indexList</em></code>
	5462	</dt>
	5463	<dd>
	5464	<p>
	5465	This option is designed for use when sorting nested lists. The
	5466	<em>indexList</em> gives a path of indices (much as might be used with
	5467	the lindex or lset commands) within each element to specify the
	5468	value to be used for comparison.
	5469	</p>
	5470	</dd>
	5471	<dt class="hdlist1">
	5472	<code><strong>-stride</strong> <em>strideLength</em></code>
	5473	</dt>
	5474	<dd>
	5475	<p>
	5476	If this option is specified, the list is treated as consisting of
	5477	groups of <em>strideLength</em> elements and the groups are sorted by
	5478	either their first element or, if the <code>-index</code> option is used,
	5479	by the element within each group given by the first index passed to
	5480	<code>-index</code> (which is then ignored by <code>-index</code>). The resulting list
	5481	is once again a flat list.
	5482	</p>
	5483	</dd>
	5484	<dt class="hdlist1">
	5485
	5486	</dt>
	5487	<dd>
	5488	<p>
	5489	The list length must be an integer multiple of <em>strideLength</em>, which
	5490	in turn must be at least 2.
	5491	</p>
	5492	</dd>
	5493	</dl></div>
5167	5494	</div>
5168	5495	<div class="sect2">
5169	5496	<h3 id="_defer">defer</h3>

5247	5574	</dd>
5248	5575	</dl></div>
5249	5576	<div class="paragraph"><p><code><em>access</em></code> defaults to <em>r</em>.</p></div>
	5577	<div class="paragraph"><p>Additionally, if POSIX mode is supported by the underlying system,
	5578	then access may insted of consistent of a list of any of the following
	5579	flags, all of which have the standard POSIX meanings. In this case,
	5580	the first flag <strong>must</strong> be one of RDONLY, WRONLY or RDWR.</p></div>
	5581	<div class="dlist"><dl>
	5582	<dt class="hdlist1">
	5583	<code>RDONLY</code>
	5584	</dt>
	5585	<dd>
	5586	<p>
	5587	Open the file for reading only.
	5588	</p>
	5589	</dd>
	5590	<dt class="hdlist1">
	5591	<code>WRONLY</code>
	5592	</dt>
	5593	<dd>
	5594	<p>
	5595	Open the file for writing only.
	5596	</p>
	5597	</dd>
	5598	<dt class="hdlist1">
	5599	<code>RDWR</code>
	5600	</dt>
	5601	<dd>
	5602	<p>
	5603	Open the file for both reading and writing.
	5604	</p>
	5605	</dd>
	5606	<dt class="hdlist1">
	5607	<code>APPEND</code>
	5608	</dt>
	5609	<dd>
	5610	<p>
	5611	Set the file pointer to the end of the file prior to each write.
	5612	</p>
	5613	</dd>
	5614	<dt class="hdlist1">
	5615	<code>BINARY</code>
	5616	</dt>
	5617	<dd>
	5618	<p>
	5619	Ignored.
	5620	</p>
	5621	</dd>
	5622	<dt class="hdlist1">
	5623	<code>CREAT</code>
	5624	</dt>
	5625	<dd>
	5626	<p>
	5627	Create the file if it does not already exist (without this flag
	5628	it is an error for the file not to exist).
	5629	</p>
	5630	</dd>
	5631	<dt class="hdlist1">
	5632	<code>EXCL</code>
	5633	</dt>
	5634	<dd>
	5635	<p>
	5636	If CREAT is also specified, an error is returned if the file
	5637	already exists.
	5638	</p>
	5639	</dd>
	5640	<dt class="hdlist1">
	5641	<code>NOCTTY</code>
	5642	</dt>
	5643	<dd>
	5644	<p>
	5645	If the file is a terminal device, this flag prevents the file
	5646	from becoming the controlling terminal of the process.
	5647	</p>
	5648	</dd>
	5649	<dt class="hdlist1">
	5650	<code>TRUNC</code>
	5651	</dt>
	5652	<dd>
	5653	<p>
	5654	If the file exists it is truncated to zero length.
	5655	</p>
	5656	</dd>
	5657	</dl></div>
5250	5658	<div class="paragraph"><p>If a file is opened for both reading and writing, then <a href="#_seek"><strong><code>seek</code></strong></a>
5251	5659	must be invoked between a read and a write, or vice versa.</p></div>
5252	5660	<div class="paragraph"><p>If the first character of <code><em>fileName</em></code> is "\|" then the remaining

5268	5676	<h3 id="_package">package</h3>
5269	5677	<div class="paragraph"><p><code><strong>package provide</strong> <em>name ?version?</em></code></p></div>
5270	5678	<div class="paragraph"><p>Indicates that the current script provides the package named <code><em>name</em></code>.
5271		If no version is specified, <em>1.0</em> is used.</p></div>
5272		<div class="paragraph"><p>Any script which provides a package may include this statement
	5679	<strong>Note</strong>: The supplied version is ignored. All packages are registered as version 1.0
	5680	(it is simply accepted for compatibility purposes).</p></div>
	5681	<div class="paragraph"><p>Any script that provides a package may include this statement
5273	5682	as the first statement, although it is not required.</p></div>
5274		<div class="paragraph"><p><code><strong>package require</strong> <em>name ?version?</em>*</code></p></div>
	5683	<div class="paragraph"><p><code><strong>package require</strong> <em>name ?version?</em></code></p></div>
5275	5684	<div class="paragraph"><p>Searches for the package with the given <code><em>name</em></code> by examining each path
5276	5685	in <em>$::auto_path</em> and trying to load <em>$path/$name.so</em> as a dynamic extension,
5277	5686	or <em>$path/$name.tcl</em> as a script package.</p></div>

5281	5690	otherwise if <em>$name.tcl</em> exists it is loaded with the <a href="#_source"><strong><code>source</code></strong></a> command.</p></div>
5282	5691	<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.
5283	5692	No further attempt will be made to locate the file.</p></div>
	5693	<div class="paragraph"><p><code><strong>package names</strong></code></p></div>
	5694	<div class="paragraph"><p>Returns a list of all known/loaded packages, including internal packages.</p></div>
5284	5695	</div>
5285	5696	<div class="sect2">
5286	5697	<h3 id="_pid">pid</h3>

5301	5712	Tcl interpreter. <code><em>args</em></code> specifies the formal arguments to the procedure.
5302	5713	If specified, <code><em>statics</em></code>, declares static variables which are bound to the
5303	5714	procedure.</p></div>
5304		<div class="paragraph"><p>See <<_procedures,PROCEDURES> for detailed information about Tcl procedures.</p></div>
	5715	<div class="paragraph"><p>See <a href="#_procedures">PROCEDURES</a> for detailed information about Tcl procedures.</p></div>
5305	5716	<div class="paragraph"><p>The <a href="#_proc"><strong><code>proc</code></strong></a> command returns <code><em>name</em></code> (which is useful with <a href="#_local"><strong><code>local</code></strong></a>).</p></div>
5306	5717	<div class="paragraph"><p>When a procedure is invoked, the procedure’s return value is the
5307	5718	value specified in a <a href="#_return"><strong><code>return</code></strong></a> command. If the procedure doesn’t

5369	5780	. range 7 4 -2
5370	5781	7 5</code></pre>
5371	5782	</div></div>
	5783	<div class="paragraph"><p>Integer parameters may be any integer expression.</p></div>
5372	5784	</div>
5373	5785	<div class="sect2">
5374	5786	<h3 id="_read">read</h3>

5376	5788	<div class="paragraph"><p><code><em>fileId</em> <strong>read</strong> ?<strong>-nonewline</strong>?</code></p></div>
5377	5789	<div class="paragraph"><p><code><strong>read</strong> <em>fileId numBytes</em></code></p></div>
5378	5790	<div class="paragraph"><p><code><em>fileId</em> <strong>read</strong> <em>numBytes</em></code></p></div>
	5791	<div class="paragraph"><p><code><strong>read</strong> ?<strong>-pending</strong>? <em>fileId</em></code></p></div>
	5792	<div class="paragraph"><p><code><em>fileId</em> <strong>read</strong> ?<strong>-pending</strong>?</code></p></div>
5379	5793	<div class="paragraph"><p>In the first form, all of the remaining bytes are read from the file
5380	5794	given by <code><em>fileId</em></code>; they are returned as the result of the command.
5381	5795	If the <code>-nonewline</code> switch is specified then the last

5384	5798	exactly this many bytes will be read and returned, unless there are fewer than
5385	5799	<code><em>numBytes</em></code> bytes left in the file; in this case, all the remaining
5386	5800	bytes are returned.</p></div>
	5801	<div class="paragraph"><p>The third form is currently only useful with SSL sockets. It reads at least 1 byte
	5802	and then any additional data that is buffered. This allows for use in an event handler.
	5803	e.g.</p></div>
	5804	<div class="listingblock">
	5805	<div class="content">
	5806	<pre><code> $sock readable {
	5807	set buf [$sock read -pending]
	5808	}</code></pre>
	5809	</div></div>
	5810	<div class="paragraph"><p>This is necessary because otherwise pending data may be buffered, but
	5811	the underlying socket will not be marked <em>readable</em>. This featured is not
	5812	currently supported for regular sockets, and so these sockets must be
	5813	set to unbufferred (<code>$sock buffering false</code>) to work in an event loop.</p></div>
5387	5814	<div class="paragraph"><p><code><em>fileId</em></code> must be <code>stdin</code> or the return value from a previous call
5388	5815	to <a href="#_open"><strong><code>open</code></strong></a>; it must refer to a file that was opened for reading.</p></div>
5389	5816	</div>

5431	5858	Use newline-sensitive matching. By default, newline
5432	5859	is a completely ordinary character with no special meaning in
5433	5860	either REs or strings. With this flag, <code>[<sup></code> bracket expressions
5434		and <code>.</code> never match newline, an <code></sup></code> anchor matches the null
	5861	and <code>.</code> never match newline, an <code></sup></code> anchor matches the empty
5435	5862	string after any newline in the string in addition to its normal
5436		function, and the <code>$</code> anchor matches the null string before any
	5863	function, and the <code>$</code> anchor matches the empty string before any
5437	5864	newline in the string in addition to its normal function.
5438	5865	</p>
5439	5866	</dd>

5558	5985	Use newline-sensitive matching. By default, newline
5559	5986	is a completely ordinary character with no special meaning in
5560	5987	either REs or strings. With this flag, <code>[<sup></code> bracket expressions
5561		and <code>.</code> never match newline, an <code></sup></code> anchor matches the null
	5988	and <code>.</code> never match newline, an <code></sup></code> anchor matches the empty
5562	5989	string after any newline in the string in addition to its normal
5563		function, and the <code>$</code> anchor matches the null string before any
	5990	function, and the <code>$</code> anchor matches the empty string before any
5564	5991	newline in the string in addition to its normal function.
5565	5992	</p>
5566	5993	</dd>

6232	6659	</dt>
6233	6660	<dd>
6234	6661	<p>
6235		See if <code><em>pattern</em></code> matches <code><em>string</em></code>; return 1 if it does, 0
6236		if it doesn’t. Matching is done in a fashion similar to that
6237		used by the C-shell. For the two strings to match, their contents
6238		must be identical except that the following special sequences
6239		may appear in <code><em>pattern</em></code>:
6240		</p>
6241		<div class="dlist"><dl>
6242		<dt class="hdlist1">
6243		<code>*</code>
6244		</dt>
6245		<dd>
6246		<p>
6247		Matches any sequence of characters in <code><em>string</em></code>,
6248		including a null string.
6249		</p>
6250		</dd>
6251		<dt class="hdlist1">
6252		<code>?</code>
6253		</dt>
6254		<dd>
6255		<p>
6256		Matches any single character in <code><em>string</em></code>.
6257		</p>
6258		</dd>
6259		<dt class="hdlist1">
6260		<code>[<em>chars</em>]</code>
6261		</dt>
6262		<dd>
6263		<p>
6264		Matches any character in the set given by <code><em>chars</em></code>.
6265		If a sequence of the form <code><em>x-y</em></code> appears in <code><em>chars</em></code>,
6266		then any character between <code><em>x</em></code> and <code><em>y</em></code>, inclusive,
6267		will match.
6268		</p>
6269		</dd>
6270		<dt class="hdlist1">
6271		<code>\x</code>
6272		</dt>
6273		<dd>
6274		<p>
6275		Matches the single character <code><em>x</em></code>. This provides a way of
6276		avoiding the special interpretation of the characters <code>\*?[]</code>
6277		in <code><em>pattern</em></code>.
6278		</p>
6279		</dd>
6280		</dl></div>
6281		</dd>
6282		<dt class="hdlist1">
6283
6284		</dt>
6285		<dd>
6286		<p>
6287		Performs a case-insensitive comparison if <code>-nocase</code> is specified.
	6662	See if <code><em>pattern</em></code> matches <code><em>string</em></code> according to
	6663	<a href="#_string_matching">STRING MATCHING</a> rules
	6664	; return 1 if it does, 0
	6665	if it doesn’t. The match is performed in a case-insensitive manner if <code>-nocase</code> is specified.
6288	6666	</p>
6289	6667	</dd>
6290	6668	<dt class="hdlist1">

6468	6846	<dd>
6469	6847	<p>
6470	6848	When matching string to the patterns, use glob-style
6471		matching (i.e. the same as implemented by the string
6472		match command).
	6849	<a href="#_string_matching">STRING MATCHING</a> rules.
6473	6850	</p>
6474	6851	</dd>
6475	6852	<dt class="hdlist1">

6477	6854	</dt>
6478	6855	<dd>
6479	6856	<p>
6480		When matching string to the patterns, use regular
6481		expression matching (i.e. the same as implemented
6482		by the regexp command).
	6857	When matching string to the patterns, use
	6858	<a href="#_regular_expressions">REGULAR EXPRESSIONS</a> rules.
6483	6859	</p>
6484	6860	</dd>
6485	6861	<dt class="hdlist1">

6803	7179	termination of the <a href="#_while"><strong><code>while</code></strong></a> command.</p></div>
6804	7180	<div class="paragraph"><p>The <a href="#_while"><strong><code>while</code></strong></a> command always returns an empty string.</p></div>
6805	7181	</div>
	7182	<div class="sect2">
	7183	<h3 id="_xtrace">xtrace</h3>
	7184	<div class="paragraph"><p><code><strong>xtrace</strong> <em>command</em></code></p></div>
	7185	<div class="paragraph"><p>Install an execution trace callback command. This is useful for implementing a debugger
	7186	or tracing tool. On each command invocation, the given command is invoked as:</p></div>
	7187	<div class="listingblock">
	7188	<div class="content">
	7189	<pre><code> command proc\|cmd filename line result command arglist</code></pre>
	7190	</div></div>
	7191	<div class="paragraph"><p><code><em>proc</em></code> or <code><em>cmd</em></code> indicates whether a command or a proc body is being executed.
	7192	<code><em>filename</em></code> and <code><em>line</em></code> indicate the location where the command was invoked.
	7193	<code><em>result</em></code> is the current interpreter result (from the previous command).
	7194	<code><em>command</em></code> and <code><em>arglist</em></code> indicate the command being executed.</p></div>
	7195	<div class="paragraph"><p>While the callback is executing, any further execution traces are temporarily disabled.
	7196	If the callback returns <code>JIM_OK</code> or <code>JIM_RETURN</code>, the execution trace is reinstalled. Otherwise
	7197	the execution trace is removed.</p></div>
	7198	<div class="paragraph"><p>If <code><strong>xtrace</strong></code> is called with an empty argument (""), any existing callback is removed.</p></div>
	7199	</div>
6806	7200	</div>
6807	7201	</div>
6808	7202	<div class="sect1">

6986	7380	</p>
6987	7381	</dd>
6988	7382	<dt class="hdlist1">
6989		<code>$handle <strong>read ?-nonewline?</strong> <em>?len?</em></code>
6990		</dt>
6991		<dd>
6992		<p>
6993		Read and return bytes from the stream. To eof if no len.
	7383	<code>$handle <strong>read ?-nonewline\|-pending</strong>\|len?'</code>
	7384	</dt>
	7385	<dd>
	7386	<p>
	7387	Read and return bytes from the stream. To eof if no len. See <a href="#_read"><strong><code>read</code></strong></a>.
6994	7388	</p>
6995	7389	</dd>
6996	7390	<dt class="hdlist1">

7067	7461	<p>
7068	7462	If no arguments are given, returns a dictionary containing the tty settings for the stream.
7069	7463	If arguments are given, they must either be a dictionary, or <code>setting value ...</code>
7070		Abbrevations are supported for both settings and values, so the following is acceptable:
	7464	Abbreviations are supported for both settings and values, so the following is acceptable:
7071	7465	<code>$f tty parity e input c out raw</code>.
7072	7466	Only available on platforms that support <em>termios(3)</em>. Supported settings are:
7073	7467	</p>

7157	7551	</dl></div>
7158	7552	</dd>
7159	7553	<dt class="hdlist1">
7160		<code>$handle <strong>ssl</strong> ?<strong>-server</strong> <em>cert priv</em>?</code>
	7554	<code>$handle <strong>ssl</strong> ?<strong>-server</strong> <em>cert ?key?</em>\|<strong>-sni</strong> <em>servername</em>?</code>
7161	7555	</dt>
7162	7556	<dd>
7163	7557	<p>
7164	7558	Upgrades the stream to a SSL/TLS session and returns the handle.
	7559	If <code>-server</code> is specified, either both the certificate and private key files
	7560	must be specified, or a single file must be specified containing both.
	7561	If <code>-server</code> is not specified, the connection is a client connection. In this case
	7562	<code>-sni</code> may be specified if required to set the Server Name Indication.
7165	7563	</p>
7166	7564	</dd>
7167	7565	<dt class="hdlist1">

7436	7834	<p>
7437	7835	A socketpair (see socketpair(2)). Like <a href="#_pipe"><strong><code>pipe</code></strong></a>, this command returns
7438	7836	a list of two channels: {s1 s2}. These channels are both readable and writable.
	7837	</p>
	7838	</dd>
	7839	<dt class="hdlist1">
	7840	<code><strong>socket pty</strong></code>
	7841	</dt>
	7842	<dd>
	7843	<p>
	7844	A pseudo-tty pair (see openpty(3)). Like <a href="#_pipe"><strong><code>pipe</code></strong></a>, this command returns
	7845	a list of two channels: {master slave}. These channels are both readable and writable.
7439	7846	</p>
7440	7847	</dd>
7441	7848	</dl></div>

7605	8012	<dd>
7606	8013	<p>
7607	8014	Decompresses a raw, Deflate-compressed stream. When the uncompressed data size is known and specified, memory
7608		allocation is more efficient. Otherwise, decomperssion is chunked and therefore slower.
	8015	allocation is more efficient. Otherwise, decompression is chunked and therefore slower.
7609	8016	</p>
7610	8017	</dd>
7611	8018	<dt class="hdlist1">

7919	8326	</p>
7920	8327	</dd>
7921	8328	<dt class="hdlist1">
	8329	<code><strong>history keep</strong> <em>?count?</em></code>
	8330	</dt>
	8331	<dd>
	8332	<p>
	8333	Set or return the maximum history size. Defaults to 100.
	8334	</p>
	8335	</dd>
	8336	<dt class="hdlist1">
7922	8337	<code><strong>history save</strong> <em>filename</em></code>
7923	8338	</dt>
7924	8339	<dd>

8036	8451	<dd>
8037	8452	<p>
8038	8453	Creates and returns a new interpreter object (command).
8039		The created interpeter contains any built-in commands along with static extensions,
	8454	The created interpreter contains any built-in commands along with static extensions,
8040	8455	but does not include any dynamically loaded commands (package require, load).
8041	8456	These must be reloaded in the child interpreter if required.
8042	8457	</p>

8046	8461	</dt>
8047	8462	<dd>
8048	8463	<p>
8049		Deletes the interpeter object.
	8464	Deletes the interpreter object.
8050	8465	</p>
8051	8466	</dd>
8052	8467	<dt class="hdlist1">

-2

appveyor.yml less more

0		version: "0.78.0.{build}"
	0	version: "0.80.0.{build}"
	1	image: Visual Studio 2019
1	2	install:
2	3	- cmd: set MSYSTEM=MINGW32
3	4	- cmd: C:\msys64\usr\bin\bash -lc "pacman --sync --noconfirm make mingw-w64-i686-gcc mingw-w64-i686-sqlite3"
4	5	- cmd: cd C:\projects & mklink /D %APPVEYOR_PROJECT_NAME% %APPVEYOR_PROJECT_SLUG% & exit 0
5	6	build_script:
6		- cmd: C:\msys64\usr\bin\bash -lc "cd /c/projects/jimtcl; ./configure --full --ssl --with-ext='sqlite3 win32 zlib' --disable-docs"
	7	- cmd: C:\msys64\usr\bin\bash -lc "cd /c/projects/jimtcl; ./configure --full --ssl --with-ext='sqlite3 win32 zlib' --disable-docs CFLAGS=-D__MINGW_USE_VC2005_COMPAT"
7	8	- cmd: C:\msys64\usr\bin\bash -lc "cd /c/projects/jimtcl; make"
8	9	test_script:
9	10	- cmd: C:\msys64\usr\bin\bash -lc "cd /c/projects/jimtcl; make test"

+211

-135

auto.def less more

0	0	# vim:se syn=tcl:
1	1	#
2	2
3		define JIM_VERSION 79
	3	define JIM_VERSION 81
4	4
5	5	options-defaults {
6	6	silent-rules 1

11	11	use local
12	12
13	13	options {
14		utf8 => "include support for utf8-encoded strings"
15		lineedit=1 => "disable line editing"
16		references=1 => "disable support for references"
17		math => "include support for math functions"
18		ssl => "include ssl/tls support in the aio extension"
19		ipv6 => "include ipv6 support in the aio extension"
20		maintainer => {enable the [debug] command and JimPanic}
21		full => "Enable some optional features: ipv6, ssl, math, utf8, binary, oo, tree"
22		with-jim-shared shared => "build a shared library instead of a static library"
23		jim-regexp=1 => "prefer POSIX regex if over the the built-in (Tcl-compatible) regex"
24		docs=1 => "don't build or install the documentation"
25		docdir:path => "path to install docs (if built)"
26		random-hash => "randomise hash tables. more secure but hash table results are not predicable"
	14	utf8 => "Include support for utf8-encoded strings"
	15	lineedit=1 => "Disable line editing"
	16	references=1 => "Disable support for references"
	17	math => "Include support for math functions"
	18	ssl => "Include ssl/tls support in the aio extension"
	19	ipv6 => "Include ipv6 support in the aio extension"
	20	maintainer => {Enable the [debug] command and JimPanic}
	21	full => "Enable some optional features: ipv6, ssl, math, utf8, and some extensions (see --extinfo)"
	22	allextmod => "Enable all non-default extensions as modules if prerequisites are found"
	23	compat => "Enable some backward compatibility behaviour"
	24	extinfo => "Show information about available extensions"
	25	with-jim-shared shared => "Build a shared library instead of a static library"
	26	jim-regexp=1 => "Prefer POSIX regex if over the the built-in (Tcl-compatible) regex"
	27	docs=1 => "Don't build or install the documentation"
	28	docdir:path => "Path to install docs (if built)"
	29	random-hash => "Randomise hash tables. more secure but hash table results are not predicable"
	30	coverage => "Build with code coverage support"
27	31	with-jim-ext: {with-ext:"ext1,ext2,..."} => {
28		Specify additional jim extensions to include.
29		These are enabled by default:
30
31		aio - ANSI I/O, including open and socket
32		eventloop - after, vwait, update
33		array - Tcl-compatible array command
34		clock - Tcl-compatible clock command
35		exec - Tcl-compatible exec command
36		file - Tcl-compatible file command
37		glob - Tcl-compatible glob command
38		history - Tcl access to interactive history
39		readdir - Required for glob
40		package - Package management with the package command
41		load - Load binary extensions at runtime with load or package
42		posix - Posix APIs including os.fork, os.uptime
43		regexp - Tcl-compatible regexp, regsub commands
44		signal - Signal handling
45		stdlib - Built-in commands including lassign, lambda, alias
46		syslog - System logging with syslog
47		tclcompat - Tcl compatible read, gets, puts, parray, case, ...
48		namespace - Tcl compatible namespace support
49
50		These are disabled by default, but enabled by --full:
51
52		oo - Jim OO extension
53		tree - OO tree structure, similar to tcllib ::struct::tree
54		binary - Tcl-compatible 'binary' command
55		tclprefix - Support for the tcl::prefix command
56		zlib - Interface to zlib
57		json - JSON encode/decode
58
59		These are disabled unless explicitly enabled:
60
61		readline - Interface to libreadline
62		rlprompt - Tcl wrapper around the readline extension
63		mk - Interface to Metakit
64		sqlite3 - Interface to sqlite3
65		win32 - Interface to win32
	32	Specify additional Jim extensions to include.
	33	Use --extinfo to show information about available extensions.
66	34	}
67	35	with-out-jim-ext: {without-ext:"default\|ext1,ext2,..."} => {
68		Specify jim extensions to exclude.
	36	Specify Jim extensions to exclude.
69	37	If 'default' is given, the default extensions will not be added.
70	38	}
71	39	with-jim-extmod: {with-mod:"ext1,ext2,..."} => {
72		Specify jim extensions to build as separate modules (either C or Tcl).
	40	Specify Jim extensions to build as separate modules (either C or Tcl).
73	41	Note that not all extensions can be built as loadable modules.
74	42	}
75	43	# To help out openocd with automake
76	44	install-jim=1
77	45	}
	46
	47	# Attributes and help for each supportted extensions
	48	# tcl=Pure Tcl extension
	49	# static=Can't be built as a module
	50	# off=Off unless explicitly enabled or required by an enabled extension
	51	# optional=Off by default, but selected by --full
	52	# cpp=Is a C++ extension
	53	global extdb
	54
	55	foreach {mod attrs help} {
	56	aio { static } {File and socket (networking) I/O}
	57	array {} {Tcl-compatible array command}
	58	binary { tcl optional } {Tcl-compatible binary command}
	59	clock {} {Tcl-compatible clock command}
	60	eventloop { static } {after, vwait, update}
	61	exec { static } {Tcl-compatible exec command}
	62	file {} {Tcl-compatible file command}
	63	glob { tcl } {Tcl-compatible glob command}
	64	history {} {Tcl access to interactive history}
	65	interp {} {Support for child interpreters}
	66	json { optional } {JSON decoder}
	67	jsonencode { tcl off } {JSON encoder}
	68	load { static } {Load binary extensions at runtime with load or package}
	69	mk { cpp off } {Interface to metakit}
	70	namespace { static } {Tcl compatible namespace support}
	71	nshelper { tcl off } {}
	72	oo { tcl } {Object Oriented class support}
	73	pack {} {Low level binary pack and unpack}
	74	package { static } {Package management with the package command}
	75	posix {} {Posix APIs including os.fork, os.uptime}
	76	readdir {} {Read the contents of a directory (used by glob)}
	77	readline { off } {Interface to libreadline}
	78	redis { off } {Client interface to redis database}
	79	regexp {} {Tcl-compatible regexp, regsub commands}
	80	rlprompt { tcl off } {readline-based REPL}
	81	sdl { off } {SDL graphics interface}
	82	signal { static } {Signal handling}
	83	sqlite3 { off } {Interface to sqlite3 database}
	84	stdlib { tcl static } {Built-in commands including lambda, stacktrace and some dict subcommands}
	85	syslog {} {System logging with syslog}
	86	tclcompat { tcl static } {Tcl compatible read, gets, puts, parray, case, ...}
	87	tclprefix { optional } {Support for the tcl::prefix command}
	88	tree { tcl } {OO tree structure, similar to tcllib ::struct::tree}
	89	win32 { off } {Interface to win32}
	90	zlib { optional } {zlib compression interface}
	91	} {
	92	dict set extdb attrs $mod $attrs
	93	dict set extdb help $mod $help
	94	}
	95
	96	if {[opt-bool extinfo]} {
	97	use text-formatting
	98	use help
	99	use_pager
	100	nl
	101	p {
	102	Jim Tcl is very modular and many extensions can be selectively
	103	enabled (--with-ext) or disabled (--without-ext).
	104	Many extensions may be statically compiled into Jim Tcl or built as loadable modules (--with-mod).
	105	This includes both C extensions and Tcl extensions.
	106	}
	107
	108	# collect extension info
	109	set attrs [dict get $extdb attrs]
	110	set info {}
	111	foreach mod [dict keys $attrs] {
	112	set help [dict get $extdb help $mod]
	113	if {$help ne ""} {
	114	if {"off" in [dict get $attrs $mod]} {
	115	set a off
	116	} elseif {"optional" in [dict get $attrs $mod]} {
	117	set a optional
	118	} else {
	119	set a default
	120	}
	121	dict set info $mod [list $a $help]
	122	}
	123	}
	124
	125	proc showmods {heading info type} {
	126	p $heading
	127	foreach mod [dict keys $info] {
	128	lassign [dict get $info $mod] a help
	129	if {$a eq $type} {
	130	puts "[format %10s $mod] - $help"
	131	}
	132	}
	133	}
	134	showmods "These extensions are enabled by default:" $info default
	135	nl
	136	showmods "These are disabled by default, but enabled by --full:" $info optional
	137	nl
	138	showmods {
	139	These are disabled unless explicitly enabled or --allextmod is selected and
	140	the prerequisites are met:
	141	} $info off
	142	exit 0
	143	}
	144
	145	# Additional information about certain extensions
	146	# dep=list of extensions which are required for this extension
	147	# check=[expr] expression to evaluate to determine if the extension can be used
	148	# libdep=list of 'define' symbols for dependent libraries
	149	# pkg-config=name1 ?args?, name2* ?args? \| name3 ?args?
	150	# Any set of packages from the alternates is acceptable (e.g. name1 and name2, or name3)
	151	# If the pkgname has a * appended, it is optional (so name1 without name2 is OK)
	152	# The optional args are pkg-config specifications (e.g. name1 >= 1.3.4)
	153	dict set extdb info {
	154	binary { dep pack }
	155	exec { check {([have-feature vfork] && [have-feature waitpid]) \|\| [have-feature system]} }
	156	glob { dep readdir }
	157	load { check {[have-feature dlopen-compat] \|\| [cc-check-function-in-lib dlopen dl]} libdep lib_dlopen }
	158	mk { check {[check-metakit]} libdep lib_mk }
	159	namespace { dep nshelper }
	160	json { dep jsonencode extrasrcs jsmn/jsmn.c }
	161	posix { check {[have-feature waitpid]} }
	162	readdir { check {[have-feature opendir]} }
	163	readline { pkg-config readline check {[cc-check-function-in-lib readline readline]} libdep lib_readline}
	164	rlprompt { dep readline }
	165	tree { dep oo }
	166	sdl { pkg-config {SDL2_gfx, SDL2_ttf* \| SDL_gfx} check false }
	167	signal { check {[have-feature sigaction]} }
	168	sqlite3 { pkg-config sqlite3 check {[cc-check-function-in-lib sqlite3_prepare_v2 sqlite3]} libdep lib_sqlite3_prepare_v2 }
	169	redis { pkg-config hiredis check {[cc-check-function-in-lib redisConnect hiredis]} libdep lib_redisConnect }
	170	zlib { pkg-config zlib check {[cc-check-function-in-lib deflate z]} libdep lib_deflate }
	171	syslog { check {[have-feature syslog]} }
	172	tree { dep oo }
	173	win32 { check {[have-feature windows]} }
	174	}
	175
	176
	177	set warnings {}
78	178
79	179	# Save the user-specified LIBS
80	180	# We add detected libs to LDLIBS explicitly

97	197	if {[cctest -cflags -fno-asynchronous-unwind-tables]} {
98	198	define-append CCOPTS -fno-asynchronous-unwind-tables
99	199	}
100
101		cc-check-includes sys/time.h sys/socket.h netinet/in.h arpa/inet.h netdb.h
102		cc-check-includes sys/un.h dlfcn.h unistd.h dirent.h crt_externs.h
	200	if {[opt-bool coverage]} {
	201	if {[cctest -link 1 -cflags --coverage]} {
	202	# When using coverage, disable ccache and compiler optimisation
	203	define CCACHE ""
	204	define-append CCOPTS --coverage -O0
	205	define-append LDFLAGS --coverage
	206	define COVERAGE 1
	207	if {[cc-check-progs gcovr]} {
	208	define COVERAGE_TOOL gcovr
	209	} elseif {[cc-check-progs lcov] && [cc-check-progs genhtml]} {
	210	define COVERAGE_TOOL lcov
	211	} else {
	212	define COVERAGE_TOOL gcov
	213	lappend warnings "Note: Neither lcov nor gcovr is available, falling back to gcov"
	214	}
	215	} else {
	216	lappend warnings "Warning: --coverage specified, but compiler does not support --coverage"
	217	}
	218	}
	219
	220	cc-check-includes time.h sys/time.h sys/socket.h netinet/in.h arpa/inet.h netdb.h
	221	cc-check-includes util.h pty.h sys/un.h dlfcn.h unistd.h dirent.h crt_externs.h execinfo.h
	222
	223	# Check sizeof time_t so we can warn on non-Y2038 compliance
	224	cc-with {-includes time.h} {
	225	cc-check-sizeof time_t
	226	}
103	227
104	228	define LDLIBS ""
105	229

123	247
124	248	if {[cc-check-function-in-lib backtrace execinfo]} {
125	249	define-append LDLIBS [get-define lib_backtrace]
	250	}
	251	if {[cc-check-function-in-lib openpty util]} {
	252	define-append LDLIBS [get-define lib_openpty]
126	253	}
127	254
128	255	if {[cc-check-functions sysinfo]} {

168	295
169	296	# Find some tools
170	297	cc-check-tools ar ranlib strip
171		define tclsh [info nameofexecutable]
	298	define tclsh [quote-if-needed [info nameofexecutable]]
172	299
173	300	# We only support silent-rules for GNU Make
174	301	define NO_SILENT_RULES

305	432	msg-result "Enabling references"
306	433	define JIM_REFERENCES
307	434	}
	435	if {[opt-bool compat]} {
	436	msg-result "Enabling compatibility mode"
	437	define JIM_COMPAT
	438	}
308	439	if {[opt-bool shared with-jim-shared]} {
309	440	msg-result "Building shared library"
310	441	} else {

313	444	}
314	445	define VERSION [format %.2f [expr {[get-define JIM_VERSION] / 100.0}]]
315	446	define LIBSOEXT [format [get-define SH_SOEXTVER] [get-define VERSION]]
316		# Disable RPATH support in Debian builds
317		define SH_LINKRPATH_FLAGS ""
	447	if {[get-define libdir] ni {/lib /usr/lib}} {
	448	define SH_LINKRPATH_FLAGS [format [get-define SH_LINKRPATH] [get-define libdir]]
	449	} else {
	450	define SH_LINKRPATH_FLAGS ""
	451	}
318	452	define JIM_INSTALL [opt-bool install-jim]
319	453	define JIM_DOCS [opt-bool docs]
320	454	define JIM_RANDOMISE_HASH [opt-bool random-hash]
321	455	define docdir [opt-str docdir o {${prefix}/docs/jim}]
322
323		# Attributes of the extensions
324		# tcl=Pure Tcl extension
325		# static=Can't be built as a module
326		# off=Off unless explicitly enabled
327		# optional=Off by default, but selected by --full
328		# cpp=Is a C++ extension
329		global extdb
330		dict set extdb attrs {
331		aio { static }
332		array {}
333		binary { tcl optional }
334		clock {}
335		eventloop { static }
336		exec { static }
337		file {}
338		glob { tcl }
339		history {}
340		interp { }
341		json { optional }
342		jsonencode { tcl optional }
343		load { static }
344		mk { cpp off }
345		namespace { static }
346		nshelper { tcl optional }
347		oo { tcl }
348		pack {}
349		package { static }
350		posix {}
351		readdir {}
352		readline { off }
353		regexp {}
354		rlprompt { tcl off }
355		sdl { off }
356		signal { static }
357		sqlite3 { off }
358		zlib { optional }
359		stdlib { tcl static }
360		syslog {}
361		tclcompat { tcl static }
362		tclprefix { optional }
363		tree { tcl }
364		win32 { off }
365		}
366
367		# Additional information about certain extensions
368		# dep=list of extensions which are required for this extension
369		# check=[expr] expression to evaluate to determine if the extension can be used
370		# libdep=list of 'define' symbols for dependent libraries
371		dict set extdb info {
372		binary { dep pack }
373		exec { check {([have-feature vfork] && [have-feature waitpid]) \|\| [have-feature system]} }
374		glob { dep readdir }
375		load { check {[have-feature dlopen-compat] \|\| [cc-check-function-in-lib dlopen dl]} libdep lib_dlopen }
376		mk { check {[check-metakit]} libdep lib_mk }
377		namespace { dep nshelper }
378		json { dep jsonencode extrasrcs jsmn/jsmn.c }
379		posix { check {[have-feature waitpid]} }
380		readdir { check {[have-feature opendir]} }
381		readline { pkg-config readline check {[cc-check-function-in-lib readline readline]} libdep lib_readline}
382		rlprompt { dep readline }
383		tree { dep oo }
384		sdl { pkg-config SDL_gfx check {[cc-check-function-in-lib SDL_SetVideoMode SDL] && [cc-check-function-in-lib rectangleRGBA SDL_gfx]}
385		libdep {lib_SDL_SetVideoMode lib_rectangleRGBA}
386		}
387		signal { check {[have-feature sigaction]} }
388		sqlite3 { pkg-config sqlite3 check {[cc-check-function-in-lib sqlite3_prepare_v2 sqlite3]} libdep lib_sqlite3_prepare_v2 }
389		zlib { pkg-config zlib check {[cc-check-function-in-lib deflate z]} libdep lib_deflate }
390		syslog { check {[have-feature syslog]} }
391		tree { dep oo }
392		win32 { check {[have-feature windows]} }
393		}
394	456
395	457	# autosetup cc-check-function-in-library can't handle C++ libraries
396	458	proc check-metakit {} {

432	494	}
433	495
434	496	# Now go check everything - see autosetup/local.tcl
435		array set extinfo [check-extensions]
	497	array set extinfo [check-extensions [opt-bool allextmod]]
436	498
437	499	# Now special checks
438	500	if {[have-feature windows]} {

519	581	if {[dict exists $extdb info $mod extrasrcs]} {
520	582	lappend srcs {*}[dict get $extdb info $mod extrasrcs]
521	583	}
522		lappend lines "$mod.so: $srcs"
	584	lappend lines "$mod.so: $srcs \$(LIBJIM)"
523	585	foreach src $srcs {
524	586	set obj [file rootname $src].o
525	587	lappend objs $obj
526	588	lappend lines "\t\$(ECHO)\t\"\tCC\t$obj\""
527		lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(SHOBJ_CFLAGS) -c -o $obj $src"
	589	lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(SHOBJ_CFLAGS) -c -o $obj \$(srcdir)/$src"
528	590	}
529	591	lappend lines "\t\$(ECHO)\t\"\tLDSO\t\$@\""
530	592	lappend lines "\t\$(Q)\$(CC) \$(CFLAGS) \$(LDFLAGS) \$(SHOBJ_LDFLAGS) -o \$@ $objs \$(SH_LIBJIM) $libs"

536	598	make-config-header jimautoconf.h -auto {jim_ext_* TCL_PLATFORM_* TCL_LIBRARY USE_* JIM_* _FILE_OFFSET} -bare {S_I}
537	599	make-template Makefile.in
538	600	make-template tests/Makefile.in
	601	make-template examples.api/Makefile.in
539	602	make-template build-jim-ext.in
540	603	make-template jimtcl.pc.in
541	604
542	605	catch {exec chmod +x build-jim-ext}
	606
	607	if {[get-define SIZEOF_TIME_T] <= 4} {
	608	set note ""
	609	if {[have-feature windows]} {
	610	set note ", consider CFLAGS=-D__MINGW_USE_VC2005_COMPAT on mingw32"
	611	}
	612	lappend warnings "Warning: sizeof(time_t) is [get-define SIZEOF_TIME_T] -- not Y2038 compliant$note"
	613	}
	614
	615	# Output any warnings at the end to make them easier to see
	616	foreach warning $warnings {
	617	user-notice $warning
	618	}

-2

autosetup/README.autosetup less more

0		README.autosetup created by autosetup v0.6.9
	0	README.autosetup created by autosetup v0.7.0+
1	1
2	2	This is the autosetup directory for a local install of autosetup.
3	3	It contains autosetup, support files and loadable modules.

7	7
8	8	*.auto files in this directory are auto-loaded.
9	9
10		For more information, see http://msteveb.github.com/autosetup/
	10	For more information, see http://msteveb.github.io/autosetup/

+101

-82

autosetup/autosetup less more

5	5	dir=`dirname "$0"`; exec "`$dir/autosetup-find-tclsh`" "$0" "$@"
6	6
7	7	# Note that the version has a trailing + on unreleased versions
8		set autosetup(version) 0.6.9
	8	set autosetup(version) 0.7.0+
9	9
10	10	# Can be set to 1 to debug early-init problems
11	11	set autosetup(debug) [expr {"--debug" in $argv}]

92	92
93	93	#"=Core Options:"
94	94	options-add {
95		help:=local => "display help and options. Optionally specify a module name, such as --help=system"
	95	help:=all => "display help and options. Optional: module name, such as --help=system"
96	96	licence license => "display the autosetup license"
97		version => "display the version of autosetup"
	97	version => "display the version of autosetup"
98	98	ref:=text manual:=text
99	99	reference:=text => "display the autosetup command reference. 'text', 'wiki', 'asciidoc' or 'markdown'"
100		debug => "display debugging output as autosetup runs"
101		install:=. => "install autosetup to the current or given directory"
	100	debug => "display debugging output as autosetup runs"
	101	install:=. => "install autosetup to the current or given directory"
102	102	}
103	103	if {$autosetup(installed)} {
104	104	# hidden options so we can produce a nice error

203	203
204	204	autosetup_add_dep $autosetup(autodef)
205	205
206		define CONFIGURE_OPTS ""
	206	# Add $argv to CONFIGURE_OPTS, but ignore duplicates and quote if needed
	207	set configure_opts {}
207	208	foreach arg $autosetup(argv) {
208		define-append CONFIGURE_OPTS [quote-if-needed $arg]
209		}
210		define AUTOREMAKE [file-normalize $autosetup(exe)]
	209	set quoted [quote-if-needed $arg]
	210	# O(n^2), but n will be small
	211	if {$quoted ni $configure_opts} {
	212	lappend configure_opts $quoted
	213	}
	214	}
	215	define CONFIGURE_OPTS [join $configure_opts]
	216	define AUTOREMAKE [quote-if-needed $autosetup(exe)]
211	217	define-append AUTOREMAKE [get-define CONFIGURE_OPTS]
212	218
213	219

215	221	configlog "Invoked as: [getenv WRAPPER $::argv0] [quote-argv $autosetup(argv)]"
216	222	configlog "Tclsh: [info nameofexecutable]"
217	223
218		# Note that auto.def is not loaded in the global scope
219		source $autosetup(autodef)
	224	# Load auto.def as module "auto.def"
	225	autosetup_load_module auto.def source $autosetup(autodef)
220	226
221	227	# Could warn here if options {} was not specified
222	228

341	347	if {![info exists result]} {
342	348	# No user-specified value. Has options-defaults been set?
343	349	foreach opt $names {
344		if {[dict exists $::autosetup(options-defaults) $opt]} {
345		set result [dict get $autosetup(options-defaults) $opt]
	350	if {[dict exists $::autosetup(optdefault) $opt]} {
	351	set result [dict get $autosetup(optdefault) $opt]
346	352	}
347	353	}
348	354	}

374	380	# Parse the option definition in $opts and update
375	381	# ::autosetup(setoptions) and ::autosetup(optionhelp) appropriately
376	382	#
377		proc options-add {opts {header ""}} {
	383	proc options-add {opts} {
378	384	global autosetup
379	385
380	386	# First weed out comment lines

390	396	set opt [lindex $opts $i]
391	397	if {[string match =* $opt]} {
392	398	# This is a special heading
393		lappend autosetup(optionhelp) $opt ""
394		set header {}
	399	lappend autosetup(optionhelp) [list $opt $autosetup(module)]
395	400	continue
396	401	}
397	402	unset -nocomplain defaultvalue equal value

452	457	# String option.
453	458	lappend autosetup(options) $name
454	459
455		if {$colon eq ":"} {
456		# Was ":name=default" given?
	460	if {$equal ne "="} {
	461	# Was the option given as "name:value=default"?
457	462	# If so, set $value to the display name and $defaultvalue to the default
458	463	# (This is the preferred way to set a default value for a string option)
459	464	if {[regexp {^([^=]+)=(.*)$} $value -> value defaultvalue]} {

467	472	set defaultvalue [dict get $autosetup(options-defaults) $name]
468	473	dict set autosetup(optdefault) $name $defaultvalue
469	474	} elseif {![info exists defaultvalue]} {
470		# For backward compatibility, if ":name" was given, use name as both
471		# the display text and the default value, but only if the user
472		# specified the option without the value
	475	# No default value was given by value=default or options-defaults
	476	# so use the value as the default when the plain option with no
	477	# value is given (.e.g. just --opt instead of --opt=value)
473	478	set defaultvalue $value
474	479	}
475	480

508	513	if {[info exists defaultvalue]} {
509	514	set desc [string map [list @default@ $defaultvalue] $desc]
510	515	}
511		#string match \n* $desc
512		if {$header ne ""} {
513		lappend autosetup(optionhelp) $header ""
514		set header ""
515		}
516	516	# A multi-line description
517		lappend autosetup(optionhelp) $opthelp $desc
	517	lappend autosetup(optionhelp) [list $opthelp $autosetup(module) $desc]
518	518	incr i 2
519	519	}
520	520	}

522	522
523	523	# @module-options optionlist
524	524	#
525		# Like 'options', but used within a module.
	525	# Deprecated. Simply use 'options' from within a module.
526	526	proc module-options {opts} {
527		set header ""
528		if {$::autosetup(showhelp) > 1 && [llength $opts]} {
529		set header "Module Options:"
530		}
531		options-add $opts $header
532
533		if {$::autosetup(showhelp)} {
534		# Ensure that the module isn't executed on --help
535		# We are running under eval or source, so use break
536		# to prevent further execution
537		#return -code break -level 2
538		return -code break
539		}
	527	options $opts
540	528	}
541	529
542	530	proc max {a b} {

565	553	}
566	554	}
567	555
568		proc options-show {} {
	556	# Display options (from $autosetup(optionhelp)) for modules that match
	557	# glob pattern $what
	558	proc options-show {what} {
	559	set local 0
569	560	# Determine the max option width
570	561	set max 0
571		foreach {opt desc} $::autosetup(optionhelp) {
	562	foreach help $::autosetup(optionhelp) {
	563	lassign $help opt module desc
	564	if {![string match $what $module]} {
	565	continue
	566	}
572	567	if {[string match =* $opt] \|\| [string match \n* $desc]} {
573	568	continue
574	569	}
575	570	set max [max $max [string length $opt]]
576	571	}
577		set indent [string repeat " " [expr $max+4]]
	572	set indent [string repeat " " [expr {$max+4}]]
578	573	set cols [getenv COLUMNS 80]
579	574	catch {
580	575	lassign [exec stty size] rows cols
581	576	}
582	577	incr cols -1
583	578	# Now output
584		foreach {opt desc} $::autosetup(optionhelp) {
	579	foreach help $::autosetup(optionhelp) {
	580	lassign $help opt module desc
	581	if {![string match $what $module]} {
	582	continue
	583	}
	584	if {$local == 0 && $module eq "auto.def"} {
	585	puts "Local Options:"
	586	incr local
	587	}
585	588	if {[string match =* $opt]} {
	589	# Output a special heading line"
586	590	puts [string range $opt 1 end]
587	591	continue
588	592	}
589	593	puts -nonewline " [format %-${max}s $opt]"
590	594	if {[string match \n* $desc]} {
	595	# Output a pre-formatted help description as-is
591	596	puts $desc
592	597	} else {
593		options-wrap-desc [string trim $desc] $cols " " $indent [expr $max + 2]
	598	options-wrap-desc [string trim $desc] $cols " " $indent [expr {$max+2}]
594	599	}
595	600	}
596	601	}

609	614	# If 'name=1' is used to make the option enabled by default, the description should reflect
610	615	# that with text like "Disable support for ...".
611	616	#
612		# An argument option (one which takes a parameter) is of the form:
613		#
614		## name:[=]value => "Description of this option"
	617	# An argument option (one which takes a parameter) is of one of the following forms:
	618	#
	619	## name:value => "Description of this option"
	620	## name:value=default => "Description of this option with a default value"
	621	## name:=value => "Description of this option with an optional value"
615	622	#
616	623	# If the 'name:value' form is used, the value must be provided with the option (as '--name=myvalue').
617		# If the 'name:=value' form is used, the value is optional and the given value is used as the default
	624	# If the 'name:value=default' form is used, the option has the given default value even if not
	625	# specified by the user.
	626	# If the 'name:=value' form is used, the value is optional and the given value is used
618	627	# if it is not provided.
619	628	#
620	629	# The description may contain '@default@', in which case it will be replaced with the default

628	637	## lfs=1 largefile=1 => "Disable large file support"
629	638	#
630	639	proc options {optlist} {
631		# Allow options as a list or args
632		options-add $optlist "Local Options:"
633
634		if {$::autosetup(showhelp)} {
635		options-show
636		exit 0
637		}
638
639		# Check for invalid options
640		if {[opt-bool option-checking]} {
641		foreach o [dict keys $::autosetup(getopt)] {
642		if {$o ni $::autosetup(options)} {
643		user-error "Unknown option --$o"
	640	global autosetup
	641
	642	options-add $optlist
	643
	644	if {$autosetup(showhelp)} {
	645	# If --help, stop now to show help
	646	return -code break
	647	}
	648
	649	if {$autosetup(module) eq "auto.def"} {
	650	# Check for invalid options
	651	if {[opt-bool option-checking]} {
	652	foreach o [dict keys $::autosetup(getopt)] {
	653	if {$o ni $::autosetup(options)} {
	654	user-error "Unknown option --$o"
	655	}
644	656	}
645	657	}
646	658	}

1172	1184	continue
1173	1185	}
1174	1186	set libmodule($m) 1
	1187
1175	1188	if {[info exists modsource(${m}.tcl)]} {
1176		automf_load eval $modsource(${m}.tcl)
	1189	autosetup_load_module $m eval $modsource(${m}.tcl)
1177	1190	} else {
1178	1191	set locs [list ${m}.tcl ${m}/init.tcl]
1179	1192	set found 0

1193	1206	# For the convenience of the "use" source, point to the directory
1194	1207	# it is being loaded from
1195	1208	set ::usedir [file dirname $source]
1196		automf_load source $source
	1209	autosetup_load_module $m source $source
1197	1210	autosetup_add_dep $source
1198	1211	} else {
1199	1212	autosetup-error "use: No such module: $m"

1206	1219	global autosetup modsource
1207	1220	# First load any embedded auto modules
1208	1221	foreach mod [array names modsource *.auto] {
1209		automf_load eval $modsource($mod)
	1222	autosetup_load_module $mod eval $modsource($mod)
1210	1223	}
1211	1224	# Now any external auto modules
1212	1225	foreach file [glob -nocomplain $autosetup(libdir)/.auto $autosetup(libdir)//*.auto] {
1213		automf_load source $file
	1226	autosetup_load_module [file tail $file] source $file
1214	1227	}
1215	1228	}
1216	1229
1217	1230	# Load module source in the global scope by executing the given command
1218		proc automf_load {args} {
	1231	proc autosetup_load_module {module args} {
	1232	global autosetup
	1233	set prev $autosetup(module)
	1234	set autosetup(module) $module
	1235
1219	1236	if {[catch [list uplevel #0 $args] msg opts] ni {0 2 3}} {
1220	1237	autosetup-full-error [error-dump $msg $opts $::autosetup(debug)]
1221	1238	}
	1239	set autosetup(module) $prev
1222	1240	}
1223	1241
1224	1242	# Initial settings

1230	1248	set autosetup(msg-checking) 0
1231	1249	set autosetup(msg-quiet) 0
1232	1250	set autosetup(inittypes) {}
	1251	set autosetup(module) autosetup
1233	1252
1234	1253	# Embedded modules are inserted below here
1235	1254	set autosetup(installed) 1

1433	1452
1434	1453	puts "Usage: [file tail $::autosetup(exe)] \[options\] \[settings\]\n"
1435	1454	puts "This is [autosetup_version], a build environment \"autoconfigurator\""
1436		puts "See the documentation online at http://msteveb.github.com/autosetup/\n"
1437
1438		if {$what eq "local"} {
	1455	puts "See the documentation online at http://msteveb.github.io/autosetup/\n"
	1456
	1457	if {$what in {all local}} {
	1458	# Need to load auto.def now
1439	1459	if {[file exists $::autosetup(autodef)]} {
1440		# This relies on auto.def having a call to 'options'
1441		# which will display options and quit
1442		source $::autosetup(autodef)
	1460	# Load auto.def as module "auto.def"
	1461	autosetup_load_module auto.def source $::autosetup(autodef)
	1462	}
	1463	if {$what eq "all"} {
	1464	set what *
1443	1465	} else {
1444		options-show
	1466	set what auto.def
1445	1467	}
1446	1468	} else {
1447		incr ::autosetup(showhelp)
1448		if {[catch {use $what}]} {
1449		user-error "Unknown module: $what"
1450		} else {
1451		options-show
1452		}
	1469	use $what
	1470	puts "Options for module $what:"
1453	1471	}
	1472	options-show $what
1454	1473	exit 0
1455	1474	}
1456	1475

1910	1929
1911	1930	*.auto files in this directory are auto-loaded.
1912	1931
1913		For more information, see http://msteveb.github.com/autosetup/
	1932	For more information, see http://msteveb.github.io/autosetup/
1914	1933	}
1915	1934	dputs "install: autosetup/README.autosetup"
1916	1935	writefile $target $readme

+895

-623

autosetup/autosetup-config.guess less more

0	0	#! /bin/sh
1	1	# Attempt to guess a canonical system name.
2		# Copyright 1992-2018 Free Software Foundation, Inc.
3
4		timestamp='2018-03-08'
	2	# Copyright 1992-2021 Free Software Foundation, Inc.
	3
	4	# shellcheck disable=SC2006,SC2268 # see below for rationale
	5
	6	timestamp='2021-06-03'
5	7
6	8	# This file is free software; you can redistribute it and/or modify it
7	9	# under the terms of the GNU General Public License as published by

26	28	# Originally written by Per Bothner; maintained since 2000 by Ben Elliston.
27	29	#
28	30	# You can get the latest version of this script from:
29		# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
	31	# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess
30	32	#
31	33	# Please send patches to <config-patches@gnu.org>.
	34
	35
	36	# The "shellcheck disable" line above the timestamp inhibits complaints
	37	# about features and limitations of the classic Bourne shell that were
	38	# superseded or lifted in POSIX. However, this script identifies a wide
	39	# variety of pre-POSIX systems that do not have POSIX shells at all, and
	40	# even some reasonably current systems (Solaris 10 as case-in-point) still
	41	# have a pre-POSIX /bin/sh.
32	42
33	43
34	44	me=`echo "$0" \| sed -e 's,.*/,,'`

49	59	GNU config.guess ($timestamp)
50	60
51	61	Originally written by Per Bothner.
52		Copyright 1992-2018 Free Software Foundation, Inc.
	62	Copyright 1992-2021 Free Software Foundation, Inc.
53	63
54	64	This is free software; see the source for copying conditions. There is NO
55	65	warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."

83	93	exit 1
84	94	fi
85	95
86		trap 'exit 1' 1 2 15
	96	# Just in case it came from the environment.
	97	GUESS=
87	98
88	99	# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
89	100	# compiler to aid in system detection is discouraged as it requires

95	106
96	107	# Portable tmp directory creation inspired by the Autoconf team.
97	108
98		set_cc_for_build='
99		trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
100		trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
101		: ${TMPDIR=/tmp} ;
102		{ tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } \|\|
103		{ test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } \|\|
104		{ tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } \|\|
105		{ echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
106		dummy=$tmp/dummy ;
107		tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
108		case $CC_FOR_BUILD,$HOST_CC,$CC in
109		,,) echo "int x;" > "$dummy.c" ;
110		for c in cc gcc c89 c99 ; do
111		if ($c -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
112		CC_FOR_BUILD="$c"; break ;
113		fi ;
114		done ;
115		if test x"$CC_FOR_BUILD" = x ; then
116		CC_FOR_BUILD=no_compiler_found ;
117		fi
118		;;
119		,,*) CC_FOR_BUILD=$CC ;;
120		,,) CC_FOR_BUILD=$HOST_CC ;;
121		esac ; set_cc_for_build= ;'
	109	tmp=
	110	# shellcheck disable=SC2172
	111	trap 'test -z "$tmp" \|\| rm -fr "$tmp"' 0 1 2 13 15
	112
	113	set_cc_for_build() {
	114	# prevent multiple calls if $tmp is already set
	115	test "$tmp" && return 0
	116	: "${TMPDIR=/tmp}"
	117	# shellcheck disable=SC2039,SC3028
	118	{ tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } \|\|
	119	{ test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } \|\|
	120	{ tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } \|\|
	121	{ echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; }
	122	dummy=$tmp/dummy
	123	case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in
	124	,,) echo "int x;" > "$dummy.c"
	125	for driver in cc gcc c89 c99 ; do
	126	if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then
	127	CC_FOR_BUILD=$driver
	128	break
	129	fi
	130	done
	131	if test x"$CC_FOR_BUILD" = x ; then
	132	CC_FOR_BUILD=no_compiler_found
	133	fi
	134	;;
	135	,,*) CC_FOR_BUILD=$CC ;;
	136	,,) CC_FOR_BUILD=$HOST_CC ;;
	137	esac
	138	}
122	139
123	140	# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
124	141	# (ghazi@noc.rutgers.edu 1994-08-24)
125		if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
	142	if test -f /.attbin/uname ; then
126	143	PATH=$PATH:/.attbin ; export PATH
127	144	fi
128	145
129	146	UNAME_MACHINE=`(uname -m) 2>/dev/null` \|\| UNAME_MACHINE=unknown
130	147	UNAME_RELEASE=`(uname -r) 2>/dev/null` \|\| UNAME_RELEASE=unknown
131		UNAME_SYSTEM=`(uname -s) 2>/dev/null` \|\| UNAME_SYSTEM=unknown
	148	UNAME_SYSTEM=`(uname -s) 2>/dev/null` \|\| UNAME_SYSTEM=unknown
132	149	UNAME_VERSION=`(uname -v) 2>/dev/null` \|\| UNAME_VERSION=unknown
133	150
134		case "$UNAME_SYSTEM" in
	151	case $UNAME_SYSTEM in
135	152	Linux\|GNU\|GNU/*)
136		# If the system lacks a compiler, then just pick glibc.
137		# We could probably try harder.
138		LIBC=gnu
139
140		eval "$set_cc_for_build"
	153	LIBC=unknown
	154
	155	set_cc_for_build
141	156	cat <<-EOF > "$dummy.c"
142	157	#include <features.h>
143	158	#if defined(__UCLIBC__)
144	159	LIBC=uclibc
145	160	#elif defined(__dietlibc__)
146	161	LIBC=dietlibc
	162	#elif defined(__GLIBC__)
	163	LIBC=gnu
147	164	#else
148		LIBC=gnu
	165	#include <stdarg.h>
	166	/* First heuristic to detect musl libc. */
	167	#ifdef __DEFINED_va_list
	168	LIBC=musl
	169	#endif
149	170	#endif
150	171	EOF
151		eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null \| grep '^LIBC' \| sed 's, ,,g'`"
152
153		# If ldd exists, use it to detect musl libc.
154		if command -v ldd >/dev/null && \
155		ldd --version 2>&1 \| grep -q ^musl
156		then
157		LIBC=musl
	172	cc_set_libc=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null \| grep '^LIBC' \| sed 's, ,,g'`
	173	eval "$cc_set_libc"
	174
	175	# Second heuristic to detect musl libc.
	176	if [ "$LIBC" = unknown ] &&
	177	command -v ldd >/dev/null &&
	178	ldd --version 2>&1 \| grep -q ^musl; then
	179	LIBC=musl
	180	fi
	181
	182	# If the system lacks a compiler, then just pick glibc.
	183	# We could probably try harder.
	184	if [ "$LIBC" = unknown ]; then
	185	LIBC=gnu
158	186	fi
159	187	;;
160	188	esac
161	189
162	190	# Note: order is significant - the case branches are not exclusive.
163	191
164		case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in
	192	case $UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in
165	193	:NetBSD::*)
166	194	# NetBSD (nbsd) targets should (where applicable) match one or
167	195	# more of the tuples: --netbsdelf, --netbsdaout,

173	201	#
174	202	# Note: NetBSD doesn't particularly care about the vendor
175	203	# portion of the name. We always set it to "unknown".
176		sysctl="sysctl -n hw.machine_arch"
177	204	UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null \|\| \
178		"/sbin/$sysctl" 2>/dev/null \|\| \
179		"/usr/sbin/$sysctl" 2>/dev/null \|\| \
	205	/sbin/sysctl -n hw.machine_arch 2>/dev/null \|\| \
	206	/usr/sbin/sysctl -n hw.machine_arch 2>/dev/null \|\| \
180	207	echo unknown)`
181		case "$UNAME_MACHINE_ARCH" in
	208	case $UNAME_MACHINE_ARCH in
	209	aarch64eb) machine=aarch64_be-unknown ;;
182	210	armeb) machine=armeb-unknown ;;
183	211	arm*) machine=arm-unknown ;;
184	212	sh3el) machine=shl-unknown ;;

187	215	earmv*)
188	216	arch=`echo "$UNAME_MACHINE_ARCH" \| sed -e 's,^e$armv[0-9]$.*$,\1,'`
189	217	endian=`echo "$UNAME_MACHINE_ARCH" \| sed -ne 's,^.*$eb$$,\1,p'`
190		machine="${arch}${endian}"-unknown
	218	machine=${arch}${endian}-unknown
191	219	;;
192		*) machine="$UNAME_MACHINE_ARCH"-unknown ;;
	220	*) machine=$UNAME_MACHINE_ARCH-unknown ;;
193	221	esac
194	222	# The Operating System including object format, if it has switched
195	223	# to ELF recently (or will in the future) and ABI.
196		case "$UNAME_MACHINE_ARCH" in
	224	case $UNAME_MACHINE_ARCH in
197	225	earm*)
198	226	os=netbsdelf
199	227	;;
200	228	arm\|i386\|m68k\|ns32k\|sh3\|sparc\|vax)
201		eval "$set_cc_for_build"
	229	set_cc_for_build
202	230	if echo __ELF__ \| $CC_FOR_BUILD -E - 2>/dev/null \
203	231	\| grep -q __ELF__
204	232	then

214	242	;;
215	243	esac
216	244	# Determine ABI tags.
217		case "$UNAME_MACHINE_ARCH" in
	245	case $UNAME_MACHINE_ARCH in
218	246	earm*)
219	247	expr='s/^earmv[0-9]/-eabi/;s/eb$//'
220	248	abi=`echo "$UNAME_MACHINE_ARCH" \| sed -e "$expr"`

225	253	# thus, need a distinct triplet. However, they do not need
226	254	# kernel version information, so it can be replaced with a
227	255	# suitable tag, in the style of linux-gnu.
228		case "$UNAME_VERSION" in
	256	case $UNAME_VERSION in
229	257	Debian*)
230	258	release='-gnu'
231	259	;;

236	264	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
237	265	# contains redundant information, the shorter form:
238	266	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
239		echo "$machine-${os}${release}${abi}"
240		exit ;;
	267	GUESS=$machine-${os}${release}${abi-}
	268	;;
241	269	:Bitrig::*)
242	270	UNAME_MACHINE_ARCH=`arch \| sed 's/Bitrig.//'`
243		echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE"
244		exit ;;
	271	GUESS=$UNAME_MACHINE_ARCH-unknown-bitrig$UNAME_RELEASE
	272	;;
245	273	:OpenBSD::*)
246	274	UNAME_MACHINE_ARCH=`arch \| sed 's/OpenBSD.//'`
247		echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE"
248		exit ;;
	275	GUESS=$UNAME_MACHINE_ARCH-unknown-openbsd$UNAME_RELEASE
	276	;;
	277	:SecBSD::*)
	278	UNAME_MACHINE_ARCH=`arch \| sed 's/SecBSD.//'`
	279	GUESS=$UNAME_MACHINE_ARCH-unknown-secbsd$UNAME_RELEASE
	280	;;
249	281	:LibertyBSD::*)
250	282	UNAME_MACHINE_ARCH=`arch \| sed 's/^.*BSD\.//'`
251		echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE"
252		exit ;;
	283	GUESS=$UNAME_MACHINE_ARCH-unknown-libertybsd$UNAME_RELEASE
	284	;;
253	285	:MidnightBSD::*)
254		echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE"
255		exit ;;
	286	GUESS=$UNAME_MACHINE-unknown-midnightbsd$UNAME_RELEASE
	287	;;
256	288	:ekkoBSD::*)
257		echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE"
258		exit ;;
	289	GUESS=$UNAME_MACHINE-unknown-ekkobsd$UNAME_RELEASE
	290	;;
259	291	:SolidBSD::*)
260		echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE"
261		exit ;;
	292	GUESS=$UNAME_MACHINE-unknown-solidbsd$UNAME_RELEASE
	293	;;
	294	:OS108::*)
	295	GUESS=$UNAME_MACHINE-unknown-os108_$UNAME_RELEASE
	296	;;
262	297	macppc:MirBSD::)
263		echo powerpc-unknown-mirbsd"$UNAME_RELEASE"
264		exit ;;
	298	GUESS=powerpc-unknown-mirbsd$UNAME_RELEASE
	299	;;
265	300	:MirBSD::*)
266		echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE"
267		exit ;;
	301	GUESS=$UNAME_MACHINE-unknown-mirbsd$UNAME_RELEASE
	302	;;
268	303	:Sortix::*)
269		echo "$UNAME_MACHINE"-unknown-sortix
270		exit ;;
	304	GUESS=$UNAME_MACHINE-unknown-sortix
	305	;;
	306	:Twizzler::*)
	307	GUESS=$UNAME_MACHINE-unknown-twizzler
	308	;;
271	309	:Redox::*)
272		echo "$UNAME_MACHINE"-unknown-redox
273		exit ;;
	310	GUESS=$UNAME_MACHINE-unknown-redox
	311	;;
274	312	mips:OSF1:.)
275		echo mips-dec-osf1
276		exit ;;
	313	GUESS=mips-dec-osf1
	314	;;
277	315	alpha:OSF1::)
	316	# Reset EXIT trap before exiting to avoid spurious non-zero exit code.
	317	trap '' 0
278	318	case $UNAME_RELEASE in
279	319	*4.0)
280	320	UNAME_RELEASE=`/usr/sbin/sizer -v \| awk '{print $3}'`

288	328	# covers most systems running today. This code pipes the CPU
289	329	# types through head -n 1, so we only detect the type of CPU 0.
290	330	ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v \| sed -n -e 's/^ The alpha $.$ processor.$/\1/p' \| head -n 1`
291		case "$ALPHA_CPU_TYPE" in
	331	case $ALPHA_CPU_TYPE in
292	332	"EV4 (21064)")
293	333	UNAME_MACHINE=alpha ;;
294	334	"EV4.5 (21064)")

325	365	# A Tn.n version is a released field test version.
326	366	# A Xn.n version is an unreleased experimental baselevel.
327	367	# 1.2 uses "1.2" for uname -r.
328		echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" \| sed -e 's/^[PVTX]//' \| tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`"
329		# Reset EXIT trap before exiting to avoid spurious non-zero exit code.
330		exitcode=$?
331		trap '' 0
332		exit $exitcode ;;
	368	OSF_REL=`echo "$UNAME_RELEASE" \| sed -e 's/^[PVTX]//' \| tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
	369	GUESS=$UNAME_MACHINE-dec-osf$OSF_REL
	370	;;
333	371	Amiga:UNIX_System_V:4.0:)
334		echo m68k-unknown-sysv4
335		exit ;;
	372	GUESS=m68k-unknown-sysv4
	373	;;
336	374	:[Aa]miga[Oo][Ss]::*)
337		echo "$UNAME_MACHINE"-unknown-amigaos
338		exit ;;
	375	GUESS=$UNAME_MACHINE-unknown-amigaos
	376	;;
339	377	:[Mm]orph[Oo][Ss]::*)
340		echo "$UNAME_MACHINE"-unknown-morphos
341		exit ;;
	378	GUESS=$UNAME_MACHINE-unknown-morphos
	379	;;
342	380	:OS/390::*)
343		echo i370-ibm-openedition
344		exit ;;
	381	GUESS=i370-ibm-openedition
	382	;;
345	383	:z/VM::*)
346		echo s390-ibm-zvmoe
347		exit ;;
	384	GUESS=s390-ibm-zvmoe
	385	;;
348	386	:OS400::*)
349		echo powerpc-ibm-os400
350		exit ;;
	387	GUESS=powerpc-ibm-os400
	388	;;
351	389	arm:RISC:1.[012]:\|arm:riscix:1.[012]:*)
352		echo arm-acorn-riscix"$UNAME_RELEASE"
353		exit ;;
	390	GUESS=arm-acorn-riscix$UNAME_RELEASE
	391	;;
354	392	arm:riscos::\|arm:RISCOS::)
355		echo arm-unknown-riscos
356		exit ;;
	393	GUESS=arm-unknown-riscos
	394	;;
357	395	SR2?01:HI-UX/MPP:: \| SR8000:HI-UX/MPP::)
358		echo hppa1.1-hitachi-hiuxmpp
359		exit ;;
	396	GUESS=hppa1.1-hitachi-hiuxmpp
	397	;;
360	398	Pyramid:OSx:: \| MIS:OSx:: \| MIS:SMP_DC-OSx::)
361	399	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
362		if test "`(/bin/universe) 2>/dev/null`" = att ; then
363		echo pyramid-pyramid-sysv3
364		else
365		echo pyramid-pyramid-bsd
366		fi
367		exit ;;
	400	case `(/bin/universe) 2>/dev/null` in
	401	att) GUESS=pyramid-pyramid-sysv3 ;;
	402	*) GUESS=pyramid-pyramid-bsd ;;
	403	esac
	404	;;
368	405	NILE::*:dcosx)
369		echo pyramid-pyramid-svr4
370		exit ;;
	406	GUESS=pyramid-pyramid-svr4
	407	;;
371	408	DRS?6000:unix:4.0:6*)
372		echo sparc-icl-nx6
373		exit ;;
	409	GUESS=sparc-icl-nx6
	410	;;
374	411	DRS?6000:UNIX_SV:4.2:7 \| DRS?6000:isis:4.2:7)
375	412	case `/usr/bin/uname -p` in
376		sparc) echo sparc-icl-nx7; exit ;;
377		esac ;;
	413	sparc) GUESS=sparc-icl-nx7 ;;
	414	esac
	415	;;
378	416	s390x:SunOS::)
379		echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" \| sed -e 's/[^.]*//'`"
380		exit ;;
	417	SUN_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[^.]*//'`
	418	GUESS=$UNAME_MACHINE-ibm-solaris2$SUN_REL
	419	;;
381	420	sun4H:SunOS:5.:)
382		echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"\|sed -e 's/[^.]*//'`"
383		exit ;;
	421	SUN_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[^.]*//'`
	422	GUESS=sparc-hal-solaris2$SUN_REL
	423	;;
384	424	sun4:SunOS:5.:* \| tadpole:SunOS:5.:*)
385		echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" \| sed -e 's/[^.]*//'`"
386		exit ;;
	425	SUN_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[^.]*//'`
	426	GUESS=sparc-sun-solaris2$SUN_REL
	427	;;
387	428	i86pc:AuroraUX:5.: \| i86xen:AuroraUX:5.:)
388		echo i386-pc-auroraux"$UNAME_RELEASE"
389		exit ;;
	429	GUESS=i386-pc-auroraux$UNAME_RELEASE
	430	;;
390	431	i86pc:SunOS:5.: \| i86xen:SunOS:5.:)
391		eval "$set_cc_for_build"
	432	set_cc_for_build
392	433	SUN_ARCH=i386
393	434	# If there is a compiler, see if it is configured for 64-bit objects.
394	435	# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
395	436	# This test works for both compilers.
396		if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
	437	if test "$CC_FOR_BUILD" != no_compiler_found; then
397	438	if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') \| \
398	439	(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) \| \
399	440	grep IS_64BIT_ARCH >/dev/null

401	442	SUN_ARCH=x86_64
402	443	fi
403	444	fi
404		echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"\|sed -e 's/[^.]*//'`"
405		exit ;;
	445	SUN_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[^.]*//'`
	446	GUESS=$SUN_ARCH-pc-solaris2$SUN_REL
	447	;;
406	448	sun4:SunOS:6:*)
407	449	# According to config.sub, this is the proper way to canonicalize
408	450	# SunOS6. Hard to guess exactly what SunOS6 will be like, but
409	451	# it's likely to be more like Solaris than SunOS4.
410		echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"\|sed -e 's/[^.]*//'`"
411		exit ;;
	452	SUN_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[^.]*//'`
	453	GUESS=sparc-sun-solaris3$SUN_REL
	454	;;
412	455	sun4:SunOS::*)
413		case "`/usr/bin/arch -k`" in
	456	case `/usr/bin/arch -k` in
414	457	Series\|S4)
415	458	UNAME_RELEASE=`uname -v`
416	459	;;
417	460	esac
418	461	# Japanese Language versions have a version number like `4.1.3-JL'.
419		echo sparc-sun-sunos"`echo "$UNAME_RELEASE"\|sed -e 's/-/_/'`"
420		exit ;;
	462	SUN_REL=`echo "$UNAME_RELEASE" \| sed -e 's/-/_/'`
	463	GUESS=sparc-sun-sunos$SUN_REL
	464	;;
421	465	sun3:SunOS::*)
422		echo m68k-sun-sunos"$UNAME_RELEASE"
423		exit ;;
	466	GUESS=m68k-sun-sunos$UNAME_RELEASE
	467	;;
424	468	sun::4.2BSD:*)
425	469	UNAME_RELEASE=`(sed 1q /etc/motd \| awk '{print substr($5,1,3)}') 2>/dev/null`
426	470	test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3
427		case "`/bin/arch`" in
	471	case `/bin/arch` in
428	472	sun3)
429		echo m68k-sun-sunos"$UNAME_RELEASE"
	473	GUESS=m68k-sun-sunos$UNAME_RELEASE
430	474	;;
431	475	sun4)
432		echo sparc-sun-sunos"$UNAME_RELEASE"
	476	GUESS=sparc-sun-sunos$UNAME_RELEASE
433	477	;;
434	478	esac
435		exit ;;
	479	;;
436	480	aushp:SunOS::)
437		echo sparc-auspex-sunos"$UNAME_RELEASE"
438		exit ;;
	481	GUESS=sparc-auspex-sunos$UNAME_RELEASE
	482	;;
439	483	# The situation for MiNT is a little confusing. The machine name
440	484	# can be virtually everything (everything which is not
441	485	# "atarist" or "atariste" at least should have a processor

445	489	# MiNT. But MiNT is downward compatible to TOS, so this should
446	490	# be no problem.
447	491	atarist[e]:MiNT::* \| atarist[e]:mint::* \| atarist[e]:TOS::*)
448		echo m68k-atari-mint"$UNAME_RELEASE"
449		exit ;;
	492	GUESS=m68k-atari-mint$UNAME_RELEASE
	493	;;
450	494	atari:MiNT:: \| atari:mint:: \| atarist[e]:TOS::*)
451		echo m68k-atari-mint"$UNAME_RELEASE"
452		exit ;;
	495	GUESS=m68k-atari-mint$UNAME_RELEASE
	496	;;
453	497	falcon:MiNT::* \| falcon:mint::* \| falcon:TOS::*)
454		echo m68k-atari-mint"$UNAME_RELEASE"
455		exit ;;
	498	GUESS=m68k-atari-mint$UNAME_RELEASE
	499	;;
456	500	milan:MiNT:: \| milan:mint:: \| milan:TOS::*)
457		echo m68k-milan-mint"$UNAME_RELEASE"
458		exit ;;
	501	GUESS=m68k-milan-mint$UNAME_RELEASE
	502	;;
459	503	hades:MiNT:: \| hades:mint:: \| hades:TOS::*)
460		echo m68k-hades-mint"$UNAME_RELEASE"
461		exit ;;
	504	GUESS=m68k-hades-mint$UNAME_RELEASE
	505	;;
462	506	:MiNT:: \| :mint:: \| :TOS::)
463		echo m68k-unknown-mint"$UNAME_RELEASE"
464		exit ;;
	507	GUESS=m68k-unknown-mint$UNAME_RELEASE
	508	;;
465	509	m68k:machten::)
466		echo m68k-apple-machten"$UNAME_RELEASE"
467		exit ;;
	510	GUESS=m68k-apple-machten$UNAME_RELEASE
	511	;;
468	512	powerpc:machten::)
469		echo powerpc-apple-machten"$UNAME_RELEASE"
470		exit ;;
	513	GUESS=powerpc-apple-machten$UNAME_RELEASE
	514	;;
471	515	RISC:Mach::*)
472		echo mips-dec-mach_bsd4.3
473		exit ;;
	516	GUESS=mips-dec-mach_bsd4.3
	517	;;
474	518	RISC:ULTRIX::*)
475		echo mips-dec-ultrix"$UNAME_RELEASE"
476		exit ;;
	519	GUESS=mips-dec-ultrix$UNAME_RELEASE
	520	;;
477	521	VAX:ULTRIX::)
478		echo vax-dec-ultrix"$UNAME_RELEASE"
479		exit ;;
	522	GUESS=vax-dec-ultrix$UNAME_RELEASE
	523	;;
480	524	2020:CLIX:: \| 2430:CLIX::)
481		echo clipper-intergraph-clix"$UNAME_RELEASE"
482		exit ;;
	525	GUESS=clipper-intergraph-clix$UNAME_RELEASE
	526	;;
483	527	mips:::UMIPS \| mips:::RISCos)
484		eval "$set_cc_for_build"
	528	set_cc_for_build
485	529	sed 's/^ //' << EOF > "$dummy.c"
486	530	#ifdef __cplusplus
487	531	#include <stdio.h> /* for printf() prototype */

507	551	dummyarg=`echo "$UNAME_RELEASE" \| sed -n 's/$[0-9]$./\1/p'` &&
508	552	SYSTEM_NAME=`"$dummy" "$dummyarg"` &&
509	553	{ echo "$SYSTEM_NAME"; exit; }
510		echo mips-mips-riscos"$UNAME_RELEASE"
511		exit ;;
	554	GUESS=mips-mips-riscos$UNAME_RELEASE
	555	;;
512	556	Motorola:PowerMAX_OS::)
513		echo powerpc-motorola-powermax
514		exit ;;
	557	GUESS=powerpc-motorola-powermax
	558	;;
515	559	Motorola::4.3:PL8-)
516		echo powerpc-harris-powermax
517		exit ;;
	560	GUESS=powerpc-harris-powermax
	561	;;
518	562	Night_Hawk:::PowerMAX_OS \| Synergy:PowerMAX_OS::)
519		echo powerpc-harris-powermax
520		exit ;;
	563	GUESS=powerpc-harris-powermax
	564	;;
521	565	Night_Hawk:Power_UNIX::)
522		echo powerpc-harris-powerunix
523		exit ;;
	566	GUESS=powerpc-harris-powerunix
	567	;;
524	568	m88k:CX/UX:7:)
525		echo m88k-harris-cxux7
526		exit ;;
	569	GUESS=m88k-harris-cxux7
	570	;;
527	571	m88k::4:R4*)
528		echo m88k-motorola-sysv4
529		exit ;;
	572	GUESS=m88k-motorola-sysv4
	573	;;
530	574	m88k::3:R3*)
531		echo m88k-motorola-sysv3
532		exit ;;
	575	GUESS=m88k-motorola-sysv3
	576	;;
533	577	AViiON:dgux::)
534	578	# DG/UX returns AViiON for all architectures
535	579	UNAME_PROCESSOR=`/usr/bin/uname -p`
536		if [ "$UNAME_PROCESSOR" = mc88100 ] \|\| [ "$UNAME_PROCESSOR" = mc88110 ]
	580	if test "$UNAME_PROCESSOR" = mc88100 \|\| test "$UNAME_PROCESSOR" = mc88110
537	581	then
538		if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] \|\| \
539		[ "$TARGET_BINARY_INTERFACE"x = x ]
	582	if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx \|\| \
	583	test "$TARGET_BINARY_INTERFACE"x = x
540	584	then
541		echo m88k-dg-dgux"$UNAME_RELEASE"
	585	GUESS=m88k-dg-dgux$UNAME_RELEASE
542	586	else
543		echo m88k-dg-dguxbcs"$UNAME_RELEASE"
	587	GUESS=m88k-dg-dguxbcs$UNAME_RELEASE
544	588	fi
545	589	else
546		echo i586-dg-dgux"$UNAME_RELEASE"
547		fi
548		exit ;;
	590	GUESS=i586-dg-dgux$UNAME_RELEASE
	591	fi
	592	;;
549	593	M88:DolphinOS::*) # DolphinOS (SVR3)
550		echo m88k-dolphin-sysv3
551		exit ;;
	594	GUESS=m88k-dolphin-sysv3
	595	;;
552	596	M88::R3:)
553	597	# Delta 88k system running SVR3
554		echo m88k-motorola-sysv3
555		exit ;;
	598	GUESS=m88k-motorola-sysv3
	599	;;
556	600	XD88:::) # Tektronix XD88 system running UTekV (SVR3)
557		echo m88k-tektronix-sysv3
558		exit ;;
	601	GUESS=m88k-tektronix-sysv3
	602	;;
559	603	Tek43[0-9][0-9]:UTek::) # Tektronix 4300 system running UTek (BSD)
560		echo m68k-tektronix-bsd
561		exit ;;
	604	GUESS=m68k-tektronix-bsd
	605	;;
562	606	:IRIX::)
563		echo mips-sgi-irix"`echo "$UNAME_RELEASE"\|sed -e 's/-/_/g'`"
564		exit ;;
	607	IRIX_REL=`echo "$UNAME_RELEASE" \| sed -e 's/-/_/g'`
	608	GUESS=mips-sgi-irix$IRIX_REL
	609	;;
565	610	????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
566		echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
567		exit ;; # Note that: echo "'`uname -s`'" gives 'AIX '
	611	GUESS=romp-ibm-aix # uname -m gives an 8 hex-code CPU id
	612	;; # Note that: echo "'`uname -s`'" gives 'AIX '
568	613	i86:AIX::*)
569		echo i386-ibm-aix
570		exit ;;
	614	GUESS=i386-ibm-aix
	615	;;
571	616	ia64:AIX::)
572		if [ -x /usr/bin/oslevel ] ; then
	617	if test -x /usr/bin/oslevel ; then
573	618	IBM_REV=`/usr/bin/oslevel`
574	619	else
575		IBM_REV="$UNAME_VERSION.$UNAME_RELEASE"
576		fi
577		echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV"
578		exit ;;
	620	IBM_REV=$UNAME_VERSION.$UNAME_RELEASE
	621	fi
	622	GUESS=$UNAME_MACHINE-ibm-aix$IBM_REV
	623	;;
579	624	*:AIX:2:3)
580	625	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
581		eval "$set_cc_for_build"
	626	set_cc_for_build
582	627	sed 's/^ //' << EOF > "$dummy.c"
583	628	#include <sys/systemcfg.h>
584	629

592	637	EOF
593	638	if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"`
594	639	then
595		echo "$SYSTEM_NAME"
	640	GUESS=$SYSTEM_NAME
596	641	else
597		echo rs6000-ibm-aix3.2.5
	642	GUESS=rs6000-ibm-aix3.2.5
598	643	fi
599	644	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
600		echo rs6000-ibm-aix3.2.4
	645	GUESS=rs6000-ibm-aix3.2.4
601	646	else
602		echo rs6000-ibm-aix3.2
603		fi
604		exit ;;
	647	GUESS=rs6000-ibm-aix3.2
	648	fi
	649	;;
605	650	:AIX::[4567])
606	651	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available \| sed 1q \| awk '{ print $1 }'`
607	652	if /usr/sbin/lsattr -El "$IBM_CPU_ID" \| grep ' POWER' >/dev/null 2>&1; then

609	654	else
610	655	IBM_ARCH=powerpc
611	656	fi
612		if [ -x /usr/bin/lslpp ] ; then
613		IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc \|
	657	if test -x /usr/bin/lslpp ; then
	658	IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc \| \
614	659	awk -F: '{ print $3 }' \| sed s/[0-9]*$/0/`
615	660	else
616		IBM_REV="$UNAME_VERSION.$UNAME_RELEASE"
617		fi
618		echo "$IBM_ARCH"-ibm-aix"$IBM_REV"
619		exit ;;
	661	IBM_REV=$UNAME_VERSION.$UNAME_RELEASE
	662	fi
	663	GUESS=$IBM_ARCH-ibm-aix$IBM_REV
	664	;;
620	665	:AIX::*)
621		echo rs6000-ibm-aix
622		exit ;;
	666	GUESS=rs6000-ibm-aix
	667	;;
623	668	ibmrt:4.4BSD:\|romp-ibm:4.4BSD:)
624		echo romp-ibm-bsd4.4
625		exit ;;
	669	GUESS=romp-ibm-bsd4.4
	670	;;
626	671	ibmrt:BSD:\|romp-ibm:BSD:*) # covers RT/PC BSD and
627		echo romp-ibm-bsd"$UNAME_RELEASE" # 4.3 with uname added to
628		exit ;; # report: romp-ibm BSD 4.3
	672	GUESS=romp-ibm-bsd$UNAME_RELEASE # 4.3 with uname added to
	673	;; # report: romp-ibm BSD 4.3
629	674	:BOSX::*)
630		echo rs6000-bull-bosx
631		exit ;;
	675	GUESS=rs6000-bull-bosx
	676	;;
632	677	DPX/2?00:B.O.S.::)
633		echo m68k-bull-sysv3
634		exit ;;
	678	GUESS=m68k-bull-sysv3
	679	;;
635	680	9000/[34]??:4.3bsd:1.:)
636		echo m68k-hp-bsd
637		exit ;;
	681	GUESS=m68k-hp-bsd
	682	;;
638	683	hp300:4.4BSD:: \| 9000/[34]??:4.3bsd:2.:)
639		echo m68k-hp-bsd4.4
640		exit ;;
	684	GUESS=m68k-hp-bsd4.4
	685	;;
641	686	9000/[34678]??:HP-UX::)
642		HPUX_REV=`echo "$UNAME_RELEASE"\|sed -e 's/[^.].[0B]//'`
643		case "$UNAME_MACHINE" in
	687	HPUX_REV=`echo "$UNAME_RELEASE" \| sed -e 's/[^.].[0B]//'`
	688	case $UNAME_MACHINE in
644	689	9000/31?) HP_ARCH=m68000 ;;
645	690	9000/[34]??) HP_ARCH=m68k ;;
646	691	9000/[678][0-9][0-9])
647		if [ -x /usr/bin/getconf ]; then
	692	if test -x /usr/bin/getconf; then
648	693	sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
649	694	sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
650		case "$sc_cpu_version" in
	695	case $sc_cpu_version in
651	696	523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0
652	697	528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1
653	698	532) # CPU_PA_RISC2_0
654		case "$sc_kernel_bits" in
	699	case $sc_kernel_bits in
655	700	32) HP_ARCH=hppa2.0n ;;
656	701	64) HP_ARCH=hppa2.0w ;;
657	702	'') HP_ARCH=hppa2.0 ;; # HP-UX 10.20
658	703	esac ;;
659	704	esac
660	705	fi
661		if [ "$HP_ARCH" = "" ]; then
662		eval "$set_cc_for_build"
	706	if test "$HP_ARCH" = ""; then
	707	set_cc_for_build
663	708	sed 's/^ //' << EOF > "$dummy.c"
664	709
665	710	#define _HPUX_SOURCE

697	742	test -z "$HP_ARCH" && HP_ARCH=hppa
698	743	fi ;;
699	744	esac
700		if [ "$HP_ARCH" = hppa2.0w ]
	745	if test "$HP_ARCH" = hppa2.0w
701	746	then
702		eval "$set_cc_for_build"
	747	set_cc_for_build
703	748
704	749	# hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
705	750	# 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler

718	763	HP_ARCH=hppa64
719	764	fi
720	765	fi
721		echo "$HP_ARCH"-hp-hpux"$HPUX_REV"
722		exit ;;
	766	GUESS=$HP_ARCH-hp-hpux$HPUX_REV
	767	;;
723	768	ia64:HP-UX::)
724		HPUX_REV=`echo "$UNAME_RELEASE"\|sed -e 's/[^.].[0B]//'`
725		echo ia64-hp-hpux"$HPUX_REV"
726		exit ;;
	769	HPUX_REV=`echo "$UNAME_RELEASE" \| sed -e 's/[^.].[0B]//'`
	770	GUESS=ia64-hp-hpux$HPUX_REV
	771	;;
727	772	3050:HI-UX::*)
728		eval "$set_cc_for_build"
	773	set_cc_for_build
729	774	sed 's/^ //' << EOF > "$dummy.c"
730	775	#include <unistd.h>
731	776	int

753	798	EOF
754	799	$CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` &&
755	800	{ echo "$SYSTEM_NAME"; exit; }
756		echo unknown-hitachi-hiuxwe2
757		exit ;;
	801	GUESS=unknown-hitachi-hiuxwe2
	802	;;
758	803	9000/7??:4.3bsd:: \| 9000/8?[79]:4.3bsd::)
759		echo hppa1.1-hp-bsd
760		exit ;;
	804	GUESS=hppa1.1-hp-bsd
	805	;;
761	806	9000/8??:4.3bsd::)
762		echo hppa1.0-hp-bsd
763		exit ;;
	807	GUESS=hppa1.0-hp-bsd
	808	;;
764	809	9??:MPE/iX:: \| 3000:MPE/iX::)
765		echo hppa1.0-hp-mpeix
766		exit ;;
	810	GUESS=hppa1.0-hp-mpeix
	811	;;
767	812	hp7??:OSF1:: \| hp8?[79]:OSF1::)
768		echo hppa1.1-hp-osf
769		exit ;;
	813	GUESS=hppa1.1-hp-osf
	814	;;
770	815	hp8??:OSF1::)
771		echo hppa1.0-hp-osf
772		exit ;;
	816	GUESS=hppa1.0-hp-osf
	817	;;
773	818	i86:OSF1::*)
774		if [ -x /usr/sbin/sysversion ] ; then
775		echo "$UNAME_MACHINE"-unknown-osf1mk
	819	if test -x /usr/sbin/sysversion ; then
	820	GUESS=$UNAME_MACHINE-unknown-osf1mk
776	821	else
777		echo "$UNAME_MACHINE"-unknown-osf1
778		fi
779		exit ;;
	822	GUESS=$UNAME_MACHINE-unknown-osf1
	823	fi
	824	;;
780	825	parisc:Lites::)
781		echo hppa1.1-hp-lites
782		exit ;;
	826	GUESS=hppa1.1-hp-lites
	827	;;
783	828	C1:ConvexOS::* \| convex:ConvexOS:C1:)
784		echo c1-convex-bsd
785		exit ;;
	829	GUESS=c1-convex-bsd
	830	;;
786	831	C2:ConvexOS::* \| convex:ConvexOS:C2:)
787	832	if getsysinfo -f scalar_acc
788	833	then echo c32-convex-bsd

790	835	fi
791	836	exit ;;
792	837	C34:ConvexOS::* \| convex:ConvexOS:C34:)
793		echo c34-convex-bsd
794		exit ;;
	838	GUESS=c34-convex-bsd
	839	;;
795	840	C38:ConvexOS::* \| convex:ConvexOS:C38:)
796		echo c38-convex-bsd
797		exit ;;
	841	GUESS=c38-convex-bsd
	842	;;
798	843	C4:ConvexOS::* \| convex:ConvexOS:C4:)
799		echo c4-convex-bsd
800		exit ;;
	844	GUESS=c4-convex-bsd
	845	;;
801	846	CRAYY-MP:::)
802		echo ymp-cray-unicos"$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'
803		exit ;;
	847	CRAY_REL=`echo "$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'`
	848	GUESS=ymp-cray-unicos$CRAY_REL
	849	;;
804	850	CRAY[A-Z]90:::)
805	851	echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \
806	852	\| sed -e 's/CRAY.*$[A-Z]90$/\1/' \

808	854	-e 's/\.[^.]*$/.X/'
809	855	exit ;;
810	856	CRAYTS:::)
811		echo t90-cray-unicos"$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'
812		exit ;;
	857	CRAY_REL=`echo "$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'`
	858	GUESS=t90-cray-unicos$CRAY_REL
	859	;;
813	860	CRAYT3E:::)
814		echo alphaev5-cray-unicosmk"$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'
815		exit ;;
	861	CRAY_REL=`echo "$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'`
	862	GUESS=alphaev5-cray-unicosmk$CRAY_REL
	863	;;
816	864	CRAYSV1:::)
817		echo sv1-cray-unicos"$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'
818		exit ;;
	865	CRAY_REL=`echo "$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'`
	866	GUESS=sv1-cray-unicos$CRAY_REL
	867	;;
819	868	:UNICOS/mp::*)
820		echo craynv-cray-unicosmp"$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'
821		exit ;;
	869	CRAY_REL=`echo "$UNAME_RELEASE" \| sed -e 's/\.[^.]*$/.X/'`
	870	GUESS=craynv-cray-unicosmp$CRAY_REL
	871	;;
822	872	F30[01]:UNIX_System_V:: \| F700:UNIX_System_V::)
823	873	FUJITSU_PROC=`uname -m \| tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`
824	874	FUJITSU_SYS=`uname -p \| tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz \| sed -e 's/\///'`
825	875	FUJITSU_REL=`echo "$UNAME_RELEASE" \| sed -e 's/ /_/'`
826		echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
827		exit ;;
	876	GUESS=${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}
	877	;;
828	878	5000:UNIX_System_V:4.:)
829	879	FUJITSU_SYS=`uname -p \| tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz \| sed -e 's/\///'`
830	880	FUJITSU_REL=`echo "$UNAME_RELEASE" \| tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz \| sed -e 's/ /_/'`
831		echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
832		exit ;;
	881	GUESS=sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}
	882	;;
833	883	i86:BSD/386::* \| i86:BSD/OS::* \| :Ascend\ Embedded/OS::*)
834		echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE"
835		exit ;;
	884	GUESS=$UNAME_MACHINE-pc-bsdi$UNAME_RELEASE
	885	;;
836	886	sparc:BSD/OS::*)
837		echo sparc-unknown-bsdi"$UNAME_RELEASE"
838		exit ;;
	887	GUESS=sparc-unknown-bsdi$UNAME_RELEASE
	888	;;
839	889	:BSD/OS::*)
840		echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE"
841		exit ;;
	890	GUESS=$UNAME_MACHINE-unknown-bsdi$UNAME_RELEASE
	891	;;
	892	arm:FreeBSD::)
	893	UNAME_PROCESSOR=`uname -p`
	894	set_cc_for_build
	895	if echo __ARM_PCS_VFP \| $CC_FOR_BUILD -E - 2>/dev/null \
	896	\| grep -q __ARM_PCS_VFP
	897	then
	898	FREEBSD_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[-(].*//'`
	899	GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabi
	900	else
	901	FREEBSD_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[-(].*//'`
	902	GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL-gnueabihf
	903	fi
	904	;;
842	905	:FreeBSD::*)
843	906	UNAME_PROCESSOR=`/usr/bin/uname -p`
844		case "$UNAME_PROCESSOR" in
	907	case $UNAME_PROCESSOR in
845	908	amd64)
846	909	UNAME_PROCESSOR=x86_64 ;;
847	910	i386)
848	911	UNAME_PROCESSOR=i586 ;;
849	912	esac
850		echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"\|sed -e 's/[-(].*//'`"
851		exit ;;
	913	FREEBSD_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[-(].*//'`
	914	GUESS=$UNAME_PROCESSOR-unknown-freebsd$FREEBSD_REL
	915	;;
852	916	i:CYGWIN:*)
853		echo "$UNAME_MACHINE"-pc-cygwin
854		exit ;;
	917	GUESS=$UNAME_MACHINE-pc-cygwin
	918	;;
855	919	:MINGW64:*)
856		echo "$UNAME_MACHINE"-pc-mingw64
857		exit ;;
	920	GUESS=$UNAME_MACHINE-pc-mingw64
	921	;;
858	922	:MINGW:*)
859		echo "$UNAME_MACHINE"-pc-mingw32
860		exit ;;
	923	GUESS=$UNAME_MACHINE-pc-mingw32
	924	;;
861	925	:MSYS:*)
862		echo "$UNAME_MACHINE"-pc-msys
863		exit ;;
	926	GUESS=$UNAME_MACHINE-pc-msys
	927	;;
864	928	i:PW:*)
865		echo "$UNAME_MACHINE"-pc-pw32
866		exit ;;
	929	GUESS=$UNAME_MACHINE-pc-pw32
	930	;;
867	931	:Interix:*)
868		case "$UNAME_MACHINE" in
	932	case $UNAME_MACHINE in
869	933	x86)
870		echo i586-pc-interix"$UNAME_RELEASE"
871		exit ;;
	934	GUESS=i586-pc-interix$UNAME_RELEASE
	935	;;
872	936	authenticamd \| genuineintel \| EM64T)
873		echo x86_64-unknown-interix"$UNAME_RELEASE"
874		exit ;;
	937	GUESS=x86_64-unknown-interix$UNAME_RELEASE
	938	;;
875	939	IA64)
876		echo ia64-unknown-interix"$UNAME_RELEASE"
877		exit ;;
	940	GUESS=ia64-unknown-interix$UNAME_RELEASE
	941	;;
878	942	esac ;;
879	943	i:UWIN:*)
880		echo "$UNAME_MACHINE"-pc-uwin
881		exit ;;
	944	GUESS=$UNAME_MACHINE-pc-uwin
	945	;;
882	946	amd64:CYGWIN::* \| x86_64:CYGWIN::*)
883		echo x86_64-unknown-cygwin
884		exit ;;
	947	GUESS=x86_64-pc-cygwin
	948	;;
885	949	prep:SunOS:5.:*)
886		echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"\|sed -e 's/[^.]*//'`"
887		exit ;;
	950	SUN_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[^.]*//'`
	951	GUESS=powerpcle-unknown-solaris2$SUN_REL
	952	;;
888	953	:GNU::*)
889	954	# the GNU system
890		echo "`echo "$UNAME_MACHINE"\|sed -e 's,[-/].$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"\|sed -e 's,/.$,,'`"
891		exit ;;
	955	GNU_ARCH=`echo "$UNAME_MACHINE" \| sed -e 's,[-/].*$,,'`
	956	GNU_REL=`echo "$UNAME_RELEASE" \| sed -e 's,/.*$,,'`
	957	GUESS=$GNU_ARCH-unknown-$LIBC$GNU_REL
	958	;;
892	959	:GNU/::)
893	960	# other systems with GNU libc and userland
894		echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" \| sed 's,^[^/]/,,' \| tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"\|sed -e 's/[-(].//'`-$LIBC"
895		exit ;;
896		i86:Minix::*)
897		echo "$UNAME_MACHINE"-pc-minix
898		exit ;;
	961	GNU_SYS=`echo "$UNAME_SYSTEM" \| sed 's,^[^/]*/,,' \| tr "[:upper:]" "[:lower:]"`
	962	GNU_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[-(].*//'`
	963	GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC
	964	;;
	965	:Minix::*)
	966	GUESS=$UNAME_MACHINE-unknown-minix
	967	;;
899	968	aarch64:Linux::)
900		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
901		exit ;;
	969	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	970	;;
902	971	aarch64_be:Linux::)
903	972	UNAME_MACHINE=aarch64_be
904		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
905		exit ;;
	973	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	974	;;
906	975	alpha:Linux::)
907		case `sed -n '/^cpu model/s/^.: $.$/\1/p' < /proc/cpuinfo` in
	976	case `sed -n '/^cpu model/s/^.: $.$/\1/p' /proc/cpuinfo 2>/dev/null` in
908	977	EV5) UNAME_MACHINE=alphaev5 ;;
909	978	EV56) UNAME_MACHINE=alphaev56 ;;
910	979	PCA56) UNAME_MACHINE=alphapca56 ;;

915	984	esac
916	985	objdump --private-headers /bin/sh \| grep -q ld.so.1
917	986	if test "$?" = 0 ; then LIBC=gnulibc1 ; fi
918		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
919		exit ;;
920		arc:Linux:: \| arceb:Linux::)
921		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
922		exit ;;
	987	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	988	;;
	989	arc:Linux:: \| arceb:Linux:: \| arc32:Linux:: \| arc64:Linux::)
	990	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	991	;;
923	992	arm:Linux::*)
924		eval "$set_cc_for_build"
	993	set_cc_for_build
925	994	if echo __ARM_EABI__ \| $CC_FOR_BUILD -E - 2>/dev/null \
926	995	\| grep -q __ARM_EABI__
927	996	then
928		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
	997	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
929	998	else
930	999	if echo __ARM_PCS_VFP \| $CC_FOR_BUILD -E - 2>/dev/null \
931	1000	\| grep -q __ARM_PCS_VFP
932	1001	then
933		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi
	1002	GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabi
934	1003	else
935		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf
	1004	GUESS=$UNAME_MACHINE-unknown-linux-${LIBC}eabihf
936	1005	fi
937	1006	fi
938		exit ;;
	1007	;;
939	1008	avr32:Linux::*)
940		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
941		exit ;;
	1009	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1010	;;
942	1011	cris:Linux::)
943		echo "$UNAME_MACHINE"-axis-linux-"$LIBC"
944		exit ;;
	1012	GUESS=$UNAME_MACHINE-axis-linux-$LIBC
	1013	;;
945	1014	crisv32:Linux::)
946		echo "$UNAME_MACHINE"-axis-linux-"$LIBC"
947		exit ;;
	1015	GUESS=$UNAME_MACHINE-axis-linux-$LIBC
	1016	;;
948	1017	e2k:Linux::)
949		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
950		exit ;;
	1018	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1019	;;
951	1020	frv:Linux::)
952		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
953		exit ;;
	1021	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1022	;;
954	1023	hexagon:Linux::)
955		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
956		exit ;;
	1024	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1025	;;
957	1026	i86:Linux::*)
958		echo "$UNAME_MACHINE"-pc-linux-"$LIBC"
959		exit ;;
	1027	GUESS=$UNAME_MACHINE-pc-linux-$LIBC
	1028	;;
960	1029	ia64:Linux::)
961		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
962		exit ;;
	1030	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1031	;;
963	1032	k1om:Linux::)
964		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
965		exit ;;
	1033	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1034	;;
	1035	loongarch32:Linux:: \| loongarch64:Linux:: \| loongarchx32:Linux::)
	1036	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1037	;;
966	1038	m32r:Linux::*)
967		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
968		exit ;;
	1039	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1040	;;
969	1041	m68:Linux::*)
970		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
971		exit ;;
	1042	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1043	;;
972	1044	mips:Linux:: \| mips64:Linux::)
973		eval "$set_cc_for_build"
	1045	set_cc_for_build
	1046	IS_GLIBC=0
	1047	test x"${LIBC}" = xgnu && IS_GLIBC=1
974	1048	sed 's/^ //' << EOF > "$dummy.c"
975	1049	#undef CPU
976		#undef ${UNAME_MACHINE}
977		#undef ${UNAME_MACHINE}el
	1050	#undef mips
	1051	#undef mipsel
	1052	#undef mips64
	1053	#undef mips64el
	1054	#if ${IS_GLIBC} && defined(_ABI64)
	1055	LIBCABI=gnuabi64
	1056	#else
	1057	#if ${IS_GLIBC} && defined(_ABIN32)
	1058	LIBCABI=gnuabin32
	1059	#else
	1060	LIBCABI=${LIBC}
	1061	#endif
	1062	#endif
	1063
	1064	#if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
	1065	CPU=mipsisa64r6
	1066	#else
	1067	#if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6
	1068	CPU=mipsisa32r6
	1069	#else
	1070	#if defined(__mips64)
	1071	CPU=mips64
	1072	#else
	1073	CPU=mips
	1074	#endif
	1075	#endif
	1076	#endif
	1077
978	1078	#if defined(__MIPSEL__) \|\| defined(__MIPSEL) \|\| defined(_MIPSEL) \|\| defined(MIPSEL)
979		CPU=${UNAME_MACHINE}el
	1079	MIPS_ENDIAN=el
980	1080	#else
981	1081	#if defined(__MIPSEB__) \|\| defined(__MIPSEB) \|\| defined(_MIPSEB) \|\| defined(MIPSEB)
982		CPU=${UNAME_MACHINE}
	1082	MIPS_ENDIAN=
983	1083	#else
984		CPU=
	1084	MIPS_ENDIAN=
985	1085	#endif
986	1086	#endif
987	1087	EOF
988		eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null \| grep '^CPU'`"
989		test "x$CPU" != x && { echo "$CPU-unknown-linux-$LIBC"; exit; }
	1088	cc_set_vars=`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null \| grep '^CPU\\|^MIPS_ENDIAN\\|^LIBCABI'`
	1089	eval "$cc_set_vars"
	1090	test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; }
990	1091	;;
991	1092	mips64el:Linux::)
992		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
993		exit ;;
	1093	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1094	;;
994	1095	openrisc:Linux::*)
995		echo or1k-unknown-linux-"$LIBC"
996		exit ;;
	1096	GUESS=or1k-unknown-linux-$LIBC
	1097	;;
997	1098	or32:Linux:: \| or1k:Linux::*)
998		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
999		exit ;;
	1099	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1100	;;
1000	1101	padre:Linux::)
1001		echo sparc-unknown-linux-"$LIBC"
1002		exit ;;
	1102	GUESS=sparc-unknown-linux-$LIBC
	1103	;;
1003	1104	parisc64:Linux:: \| hppa64:Linux::)
1004		echo hppa64-unknown-linux-"$LIBC"
1005		exit ;;
	1105	GUESS=hppa64-unknown-linux-$LIBC
	1106	;;
1006	1107	parisc:Linux:: \| hppa:Linux::)
1007	1108	# Look for CPU level
1008	1109	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null \| cut -d' ' -f2` in
1009		PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;;
1010		PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;;
1011		*) echo hppa-unknown-linux-"$LIBC" ;;
	1110	PA7*) GUESS=hppa1.1-unknown-linux-$LIBC ;;
	1111	PA8*) GUESS=hppa2.0-unknown-linux-$LIBC ;;
	1112	*) GUESS=hppa-unknown-linux-$LIBC ;;
1012	1113	esac
1013		exit ;;
	1114	;;
1014	1115	ppc64:Linux::)
1015		echo powerpc64-unknown-linux-"$LIBC"
1016		exit ;;
	1116	GUESS=powerpc64-unknown-linux-$LIBC
	1117	;;
1017	1118	ppc:Linux::)
1018		echo powerpc-unknown-linux-"$LIBC"
1019		exit ;;
	1119	GUESS=powerpc-unknown-linux-$LIBC
	1120	;;
1020	1121	ppc64le:Linux::)
1021		echo powerpc64le-unknown-linux-"$LIBC"
1022		exit ;;
	1122	GUESS=powerpc64le-unknown-linux-$LIBC
	1123	;;
1023	1124	ppcle:Linux::)
1024		echo powerpcle-unknown-linux-"$LIBC"
1025		exit ;;
1026		riscv32:Linux:: \| riscv64:Linux::)
1027		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
1028		exit ;;
	1125	GUESS=powerpcle-unknown-linux-$LIBC
	1126	;;
	1127	riscv32:Linux:: \| riscv32be:Linux:: \| riscv64:Linux:: \| riscv64be:Linux::)
	1128	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1129	;;
1029	1130	s390:Linux:: \| s390x:Linux::)
1030		echo "$UNAME_MACHINE"-ibm-linux-"$LIBC"
1031		exit ;;
	1131	GUESS=$UNAME_MACHINE-ibm-linux-$LIBC
	1132	;;
1032	1133	sh64:Linux::*)
1033		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
1034		exit ;;
	1134	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1135	;;
1035	1136	sh:Linux::*)
1036		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
1037		exit ;;
	1137	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1138	;;
1038	1139	sparc:Linux:: \| sparc64:Linux::)
1039		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
1040		exit ;;
	1140	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1141	;;
1041	1142	tile:Linux::*)
1042		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
1043		exit ;;
	1143	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1144	;;
1044	1145	vax:Linux::)
1045		echo "$UNAME_MACHINE"-dec-linux-"$LIBC"
1046		exit ;;
	1146	GUESS=$UNAME_MACHINE-dec-linux-$LIBC
	1147	;;
1047	1148	x86_64:Linux::)
1048		echo "$UNAME_MACHINE"-pc-linux-"$LIBC"
1049		exit ;;
	1149	set_cc_for_build
	1150	LIBCABI=$LIBC
	1151	if test "$CC_FOR_BUILD" != no_compiler_found; then
	1152	if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') \| \
	1153	(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) \| \
	1154	grep IS_X32 >/dev/null
	1155	then
	1156	LIBCABI=${LIBC}x32
	1157	fi
	1158	fi
	1159	GUESS=$UNAME_MACHINE-pc-linux-$LIBCABI
	1160	;;
1050	1161	xtensa:Linux::*)
1051		echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"
1052		exit ;;
	1162	GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
	1163	;;
1053	1164	i86:DYNIX/ptx:4:*)
1054	1165	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
1055	1166	# earlier versions are messed up and put the nodename in both
1056	1167	# sysname and nodename.
1057		echo i386-sequent-sysv4
1058		exit ;;
	1168	GUESS=i386-sequent-sysv4
	1169	;;
1059	1170	i86:UNIX_SV:4.2MP:2.)
1060	1171	# Unixware is an offshoot of SVR4, but it has its own version
1061	1172	# number series starting with 2...
1062	1173	# I am not positive that other SVR4 systems won't match this,
1063	1174	# I just have to hope. -- rms.
1064	1175	# Use sysv4.2uw... so that sysv4* matches it.
1065		echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION"
1066		exit ;;
	1176	GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION
	1177	;;
1067	1178	i86:OS/2::*)
1068	1179	# If we were able to find `uname', then EMX Unix compatibility
1069	1180	# is probably installed.
1070		echo "$UNAME_MACHINE"-pc-os2-emx
1071		exit ;;
	1181	GUESS=$UNAME_MACHINE-pc-os2-emx
	1182	;;
1072	1183	i86:XTS-300::STOP)
1073		echo "$UNAME_MACHINE"-unknown-stop
1074		exit ;;
	1184	GUESS=$UNAME_MACHINE-unknown-stop
	1185	;;
1075	1186	i86:atheos::*)
1076		echo "$UNAME_MACHINE"-unknown-atheos
1077		exit ;;
	1187	GUESS=$UNAME_MACHINE-unknown-atheos
	1188	;;
1078	1189	i86:syllable::*)
1079		echo "$UNAME_MACHINE"-pc-syllable
1080		exit ;;
	1190	GUESS=$UNAME_MACHINE-pc-syllable
	1191	;;
1081	1192	i86:LynxOS:2.:* \| i86:LynxOS:3.[01]:* \| i86:LynxOS:4.[02]:*)
1082		echo i386-unknown-lynxos"$UNAME_RELEASE"
1083		exit ;;
	1193	GUESS=i386-unknown-lynxos$UNAME_RELEASE
	1194	;;
1084	1195	i86:DOS::)
1085		echo "$UNAME_MACHINE"-pc-msdosdjgpp
1086		exit ;;
	1196	GUESS=$UNAME_MACHINE-pc-msdosdjgpp
	1197	;;
1087	1198	i86::4.:)
1088	1199	UNAME_REL=`echo "$UNAME_RELEASE" \| sed 's/\/MP$//'`
1089	1200	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
1090		echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL"
	1201	GUESS=$UNAME_MACHINE-univel-sysv$UNAME_REL
1091	1202	else
1092		echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL"
1093		fi
1094		exit ;;
	1203	GUESS=$UNAME_MACHINE-pc-sysv$UNAME_REL
	1204	fi
	1205	;;
1095	1206	i86::5:[678]*)
1096	1207	# UnixWare 7.x, OpenUNIX and OpenServer 6.
1097	1208	case `/bin/uname -X \| grep "^Machine"` in

1099	1210	*Pentium) UNAME_MACHINE=i586 ;;
1100	1211	Pent\|*Celeron) UNAME_MACHINE=i686 ;;
1101	1212	esac
1102		echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}{$UNAME_VERSION}"
1103		exit ;;
	1213	GUESS=$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
	1214	;;
1104	1215	i86::3.2:*)
1105	1216	if test -f /usr/options/cb.name; then
1106	1217	UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
1107		echo "$UNAME_MACHINE"-pc-isc"$UNAME_REL"
	1218	GUESS=$UNAME_MACHINE-pc-isc$UNAME_REL
1108	1219	elif /bin/uname -X 2>/dev/null >/dev/null ; then
1109	1220	UNAME_REL=`(/bin/uname -X\|grep Release\|sed -e 's/.*= //')`
1110	1221	(/bin/uname -X\|grep i80486 >/dev/null) && UNAME_MACHINE=i486

1114	1225	&& UNAME_MACHINE=i686
1115	1226	(/bin/uname -X\|grep '^Machine.*Pentium Pro' >/dev/null) \
1116	1227	&& UNAME_MACHINE=i686
1117		echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL"
	1228	GUESS=$UNAME_MACHINE-pc-sco$UNAME_REL
1118	1229	else
1119		echo "$UNAME_MACHINE"-pc-sysv32
1120		fi
1121		exit ;;
	1230	GUESS=$UNAME_MACHINE-pc-sysv32
	1231	fi
	1232	;;
1122	1233	pc:::*)
1123	1234	# Left here for compatibility:
1124	1235	# uname -m prints for DJGPP always 'pc', but it prints nothing about

1126	1237	# Note: whatever this is, it MUST be the same as what config.sub
1127	1238	# prints for the "djgpp" host, or else GDB configure will decide that
1128	1239	# this is a cross-build.
1129		echo i586-pc-msdosdjgpp
1130		exit ;;
	1240	GUESS=i586-pc-msdosdjgpp
	1241	;;
1131	1242	Intel:Mach:3:)
1132		echo i386-pc-mach3
1133		exit ;;
	1243	GUESS=i386-pc-mach3
	1244	;;
1134	1245	paragon:::*)
1135		echo i860-intel-osf1
1136		exit ;;
	1246	GUESS=i860-intel-osf1
	1247	;;
1137	1248	i860::4.:*) # i860-SVR4
1138	1249	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
1139		echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4
	1250	GUESS=i860-stardent-sysv$UNAME_RELEASE # Stardent Vistra i860-SVR4
1140	1251	else # Add other i860-SVR4 vendors below as they are discovered.
1141		echo i860-unknown-sysv"$UNAME_RELEASE" # Unknown i860-SVR4
1142		fi
1143		exit ;;
	1252	GUESS=i860-unknown-sysv$UNAME_RELEASE # Unknown i860-SVR4
	1253	fi
	1254	;;
1144	1255	mini:CTIX:SYS5:*)
1145	1256	# "miniframe"
1146		echo m68010-convergent-sysv
1147		exit ;;
	1257	GUESS=m68010-convergent-sysv
	1258	;;
1148	1259	mc68k:UNIX:SYSTEM5:3.51m)
1149		echo m68k-convergent-sysv
1150		exit ;;
	1260	GUESS=m68k-convergent-sysv
	1261	;;
1151	1262	M680?0:D-NIX:5.3:*)
1152		echo m68k-diab-dnix
1153		exit ;;
	1263	GUESS=m68k-diab-dnix
	1264	;;
1154	1265	M68::R3V[5678]:)
1155	1266	test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
1156	1267	3[345]??::4.0:3.0 \| 3[34]??A::4.0:3.0 \| 3[34]??,::4.0:3.0 \| 3[34]??/::4.0:3.0 \| 4400::4.0:3.0 \| 4850::4.0:3.0 \| SKA40::4.0:3.0 \| SDS2::4.0:3.0 \| SHG2::4.0:3.0 \| S7501:*:4.0:3.0)

1175	1286	/bin/uname -p 2>/dev/null \| /bin/grep pteron >/dev/null \
1176	1287	&& { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;;
1177	1288	m68:LynxOS:2.:* \| m68:LynxOS:3.0:*)
1178		echo m68k-unknown-lynxos"$UNAME_RELEASE"
1179		exit ;;
	1289	GUESS=m68k-unknown-lynxos$UNAME_RELEASE
	1290	;;
1180	1291	mc68030:UNIX_System_V:4.:)
1181		echo m68k-atari-sysv4
1182		exit ;;
	1292	GUESS=m68k-atari-sysv4
	1293	;;
1183	1294	TSUNAMI:LynxOS:2.:)
1184		echo sparc-unknown-lynxos"$UNAME_RELEASE"
1185		exit ;;
	1295	GUESS=sparc-unknown-lynxos$UNAME_RELEASE
	1296	;;
1186	1297	rs6000:LynxOS:2.:)
1187		echo rs6000-unknown-lynxos"$UNAME_RELEASE"
1188		exit ;;
	1298	GUESS=rs6000-unknown-lynxos$UNAME_RELEASE
	1299	;;
1189	1300	PowerPC:LynxOS:2.: \| PowerPC:LynxOS:3.[01]: \| PowerPC:LynxOS:4.[02]:)
1190		echo powerpc-unknown-lynxos"$UNAME_RELEASE"
1191		exit ;;
	1301	GUESS=powerpc-unknown-lynxos$UNAME_RELEASE
	1302	;;
1192	1303	SM[BE]S:UNIX_SV::)
1193		echo mips-dde-sysv"$UNAME_RELEASE"
1194		exit ;;
	1304	GUESS=mips-dde-sysv$UNAME_RELEASE
	1305	;;
1195	1306	RM:ReliantUNIX-::)
1196		echo mips-sni-sysv4
1197		exit ;;
	1307	GUESS=mips-sni-sysv4
	1308	;;
1198	1309	RM:SINIX-::)
1199		echo mips-sni-sysv4
1200		exit ;;
	1310	GUESS=mips-sni-sysv4
	1311	;;
1201	1312	:SINIX-::)
1202	1313	if uname -p 2>/dev/null >/dev/null ; then
1203	1314	UNAME_MACHINE=`(uname -p) 2>/dev/null`
1204		echo "$UNAME_MACHINE"-sni-sysv4
	1315	GUESS=$UNAME_MACHINE-sni-sysv4
1205	1316	else
1206		echo ns32k-sni-sysv
1207		fi
1208		exit ;;
	1317	GUESS=ns32k-sni-sysv
	1318	fi
	1319	;;
1209	1320	PENTIUM::4.0:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
1210	1321	# says <Richard.M.Bartel@ccMail.Census.GOV>
1211		echo i586-unisys-sysv4
1212		exit ;;
	1322	GUESS=i586-unisys-sysv4
	1323	;;
1213	1324	:UNIX_System_V:4:FTX*)
1214	1325	# From Gerald Hewes <hewes@openmarket.com>.
1215	1326	# How about differentiating between stratus architectures? -djm
1216		echo hppa1.1-stratus-sysv4
1217		exit ;;
	1327	GUESS=hppa1.1-stratus-sysv4
	1328	;;
1218	1329	:::FTX)
1219	1330	# From seanf@swdc.stratus.com.
1220		echo i860-stratus-sysv4
1221		exit ;;
	1331	GUESS=i860-stratus-sysv4
	1332	;;
1222	1333	i86:VOS::*)
1223	1334	# From Paul.Green@stratus.com.
1224		echo "$UNAME_MACHINE"-stratus-vos
1225		exit ;;
	1335	GUESS=$UNAME_MACHINE-stratus-vos
	1336	;;
1226	1337	:VOS::*)
1227	1338	# From Paul.Green@stratus.com.
1228		echo hppa1.1-stratus-vos
1229		exit ;;
	1339	GUESS=hppa1.1-stratus-vos
	1340	;;
1230	1341	mc68:A/UX::*)
1231		echo m68k-apple-aux"$UNAME_RELEASE"
1232		exit ;;
	1342	GUESS=m68k-apple-aux$UNAME_RELEASE
	1343	;;
1233	1344	news:NEWS-OS:6:*)
1234		echo mips-sony-newsos6
1235		exit ;;
	1345	GUESS=mips-sony-newsos6
	1346	;;
1236	1347	R[34]000:System_V:: \| R4000:UNIX_SYSV:: \| R000:UNIX_SV::*)
1237		if [ -d /usr/nec ]; then
1238		echo mips-nec-sysv"$UNAME_RELEASE"
	1348	if test -d /usr/nec; then
	1349	GUESS=mips-nec-sysv$UNAME_RELEASE
1239	1350	else
1240		echo mips-unknown-sysv"$UNAME_RELEASE"
1241		fi
1242		exit ;;
	1351	GUESS=mips-unknown-sysv$UNAME_RELEASE
	1352	fi
	1353	;;
1243	1354	BeBox:BeOS::) # BeOS running on hardware made by Be, PPC only.
1244		echo powerpc-be-beos
1245		exit ;;
	1355	GUESS=powerpc-be-beos
	1356	;;
1246	1357	BeMac:BeOS::) # BeOS running on Mac or Mac clone, PPC only.
1247		echo powerpc-apple-beos
1248		exit ;;
	1358	GUESS=powerpc-apple-beos
	1359	;;
1249	1360	BePC:BeOS::) # BeOS running on Intel PC compatible.
1250		echo i586-pc-beos
1251		exit ;;
	1361	GUESS=i586-pc-beos
	1362	;;
1252	1363	BePC:Haiku::) # Haiku running on Intel PC compatible.
1253		echo i586-pc-haiku
1254		exit ;;
	1364	GUESS=i586-pc-haiku
	1365	;;
1255	1366	x86_64:Haiku::)
1256		echo x86_64-unknown-haiku
1257		exit ;;
	1367	GUESS=x86_64-unknown-haiku
	1368	;;
1258	1369	SX-4:SUPER-UX::)
1259		echo sx4-nec-superux"$UNAME_RELEASE"
1260		exit ;;
	1370	GUESS=sx4-nec-superux$UNAME_RELEASE
	1371	;;
1261	1372	SX-5:SUPER-UX::)
1262		echo sx5-nec-superux"$UNAME_RELEASE"
1263		exit ;;
	1373	GUESS=sx5-nec-superux$UNAME_RELEASE
	1374	;;
1264	1375	SX-6:SUPER-UX::)
1265		echo sx6-nec-superux"$UNAME_RELEASE"
1266		exit ;;
	1376	GUESS=sx6-nec-superux$UNAME_RELEASE
	1377	;;
1267	1378	SX-7:SUPER-UX::)
1268		echo sx7-nec-superux"$UNAME_RELEASE"
1269		exit ;;
	1379	GUESS=sx7-nec-superux$UNAME_RELEASE
	1380	;;
1270	1381	SX-8:SUPER-UX::)
1271		echo sx8-nec-superux"$UNAME_RELEASE"
1272		exit ;;
	1382	GUESS=sx8-nec-superux$UNAME_RELEASE
	1383	;;
1273	1384	SX-8R:SUPER-UX::)
1274		echo sx8r-nec-superux"$UNAME_RELEASE"
1275		exit ;;
	1385	GUESS=sx8r-nec-superux$UNAME_RELEASE
	1386	;;
1276	1387	SX-ACE:SUPER-UX::)
1277		echo sxace-nec-superux"$UNAME_RELEASE"
1278		exit ;;
	1388	GUESS=sxace-nec-superux$UNAME_RELEASE
	1389	;;
1279	1390	Power:Rhapsody::*)
1280		echo powerpc-apple-rhapsody"$UNAME_RELEASE"
1281		exit ;;
	1391	GUESS=powerpc-apple-rhapsody$UNAME_RELEASE
	1392	;;
1282	1393	:Rhapsody::*)
1283		echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE"
1284		exit ;;
	1394	GUESS=$UNAME_MACHINE-apple-rhapsody$UNAME_RELEASE
	1395	;;
	1396	arm64:Darwin::)
	1397	GUESS=aarch64-apple-darwin$UNAME_RELEASE
	1398	;;
1285	1399	:Darwin::*)
1286		UNAME_PROCESSOR=`uname -p` \|\| UNAME_PROCESSOR=unknown
1287		eval "$set_cc_for_build"
1288		if test "$UNAME_PROCESSOR" = unknown ; then
1289		UNAME_PROCESSOR=powerpc
1290		fi
1291		if test "`echo "$UNAME_RELEASE" \| sed -e 's/\..*//'`" -le 10 ; then
1292		if [ "$CC_FOR_BUILD" != no_compiler_found ]; then
1293		if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') \| \
1294		(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) \| \
1295		grep IS_64BIT_ARCH >/dev/null
1296		then
1297		case $UNAME_PROCESSOR in
1298		i386) UNAME_PROCESSOR=x86_64 ;;
1299		powerpc) UNAME_PROCESSOR=powerpc64 ;;
1300		esac
1301		fi
1302		# On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc
1303		if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') \| \
1304		(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) \| \
1305		grep IS_PPC >/dev/null
1306		then
1307		UNAME_PROCESSOR=powerpc
1308		fi
	1400	UNAME_PROCESSOR=`uname -p`
	1401	case $UNAME_PROCESSOR in
	1402	unknown) UNAME_PROCESSOR=powerpc ;;
	1403	esac
	1404	if command -v xcode-select > /dev/null 2> /dev/null && \
	1405	! xcode-select --print-path > /dev/null 2> /dev/null ; then
	1406	# Avoid executing cc if there is no toolchain installed as
	1407	# cc will be a stub that puts up a graphical alert
	1408	# prompting the user to install developer tools.
	1409	CC_FOR_BUILD=no_compiler_found
	1410	else
	1411	set_cc_for_build
	1412	fi
	1413	if test "$CC_FOR_BUILD" != no_compiler_found; then
	1414	if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') \| \
	1415	(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) \| \
	1416	grep IS_64BIT_ARCH >/dev/null
	1417	then
	1418	case $UNAME_PROCESSOR in
	1419	i386) UNAME_PROCESSOR=x86_64 ;;
	1420	powerpc) UNAME_PROCESSOR=powerpc64 ;;
	1421	esac
	1422	fi
	1423	# On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc
	1424	if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') \| \
	1425	(CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) \| \
	1426	grep IS_PPC >/dev/null
	1427	then
	1428	UNAME_PROCESSOR=powerpc
1309	1429	fi
1310	1430	elif test "$UNAME_PROCESSOR" = i386 ; then
1311		# Avoid executing cc on OS X 10.9, as it ships with a stub
1312		# that puts up a graphical alert prompting to install
1313		# developer tools. Any system running Mac OS X 10.7 or
1314		# later (Darwin 11 and later) is required to have a 64-bit
1315		# processor. This is not true of the ARM version of Darwin
1316		# that Apple uses in portable devices.
1317		UNAME_PROCESSOR=x86_64
1318		fi
1319		echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE"
1320		exit ;;
	1431	# uname -m returns i386 or x86_64
	1432	UNAME_PROCESSOR=$UNAME_MACHINE
	1433	fi
	1434	GUESS=$UNAME_PROCESSOR-apple-darwin$UNAME_RELEASE
	1435	;;
1321	1436	:procnto:: \| :QNX:[0123456789]:*)
1322	1437	UNAME_PROCESSOR=`uname -p`
1323	1438	if test "$UNAME_PROCESSOR" = x86; then
1324	1439	UNAME_PROCESSOR=i386
1325	1440	UNAME_MACHINE=pc
1326	1441	fi
1327		echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE"
1328		exit ;;
	1442	GUESS=$UNAME_PROCESSOR-$UNAME_MACHINE-nto-qnx$UNAME_RELEASE
	1443	;;
1329	1444	:QNX::4*)
1330		echo i386-pc-qnx
1331		exit ;;
	1445	GUESS=i386-pc-qnx
	1446	;;
1332	1447	NEO-:NONSTOP_KERNEL::*)
1333		echo neo-tandem-nsk"$UNAME_RELEASE"
1334		exit ;;
	1448	GUESS=neo-tandem-nsk$UNAME_RELEASE
	1449	;;
1335	1450	NSE-:NONSTOP_KERNEL::*)
1336		echo nse-tandem-nsk"$UNAME_RELEASE"
1337		exit ;;
	1451	GUESS=nse-tandem-nsk$UNAME_RELEASE
	1452	;;
1338	1453	NSR-:NONSTOP_KERNEL::*)
1339		echo nsr-tandem-nsk"$UNAME_RELEASE"
1340		exit ;;
	1454	GUESS=nsr-tandem-nsk$UNAME_RELEASE
	1455	;;
1341	1456	NSV-:NONSTOP_KERNEL::*)
1342		echo nsv-tandem-nsk"$UNAME_RELEASE"
1343		exit ;;
	1457	GUESS=nsv-tandem-nsk$UNAME_RELEASE
	1458	;;
1344	1459	NSX-:NONSTOP_KERNEL::*)
1345		echo nsx-tandem-nsk"$UNAME_RELEASE"
1346		exit ;;
	1460	GUESS=nsx-tandem-nsk$UNAME_RELEASE
	1461	;;
1347	1462	:NonStop-UX::*)
1348		echo mips-compaq-nonstopux
1349		exit ;;
	1463	GUESS=mips-compaq-nonstopux
	1464	;;
1350	1465	BS2000:POSIX::*)
1351		echo bs2000-siemens-sysv
1352		exit ;;
	1466	GUESS=bs2000-siemens-sysv
	1467	;;
1353	1468	DS/:UNIX_System_V::*)
1354		echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE"
1355		exit ;;
	1469	GUESS=$UNAME_MACHINE-$UNAME_SYSTEM-$UNAME_RELEASE
	1470	;;
1356	1471	:Plan9::*)
1357	1472	# "uname -m" is not consistent, so use $cputype instead. 386
1358	1473	# is converted to i386 for consistency with other x86
1359	1474	# operating systems.
1360		if test "$cputype" = 386; then
	1475	if test "${cputype-}" = 386; then
1361	1476	UNAME_MACHINE=i386
1362		else
1363		UNAME_MACHINE="$cputype"
1364		fi
1365		echo "$UNAME_MACHINE"-unknown-plan9
1366		exit ;;
	1477	elif test "x${cputype-}" != x; then
	1478	UNAME_MACHINE=$cputype
	1479	fi
	1480	GUESS=$UNAME_MACHINE-unknown-plan9
	1481	;;
1367	1482	:TOPS-10::*)
1368		echo pdp10-unknown-tops10
1369		exit ;;
	1483	GUESS=pdp10-unknown-tops10
	1484	;;
1370	1485	:TENEX::*)
1371		echo pdp10-unknown-tenex
1372		exit ;;
	1486	GUESS=pdp10-unknown-tenex
	1487	;;
1373	1488	KS10:TOPS-20:: \| KL10:TOPS-20:: \| TYPE4:TOPS-20::)
1374		echo pdp10-dec-tops20
1375		exit ;;
	1489	GUESS=pdp10-dec-tops20
	1490	;;
1376	1491	XKL-1:TOPS-20:: \| TYPE5:TOPS-20::)
1377		echo pdp10-xkl-tops20
1378		exit ;;
	1492	GUESS=pdp10-xkl-tops20
	1493	;;
1379	1494	:TOPS-20::*)
1380		echo pdp10-unknown-tops20
1381		exit ;;
	1495	GUESS=pdp10-unknown-tops20
	1496	;;
1382	1497	:ITS::*)
1383		echo pdp10-unknown-its
1384		exit ;;
	1498	GUESS=pdp10-unknown-its
	1499	;;
1385	1500	SEI:::SEIUX)
1386		echo mips-sei-seiux"$UNAME_RELEASE"
1387		exit ;;
	1501	GUESS=mips-sei-seiux$UNAME_RELEASE
	1502	;;
1388	1503	:DragonFly::*)
1389		echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"\|sed -e 's/[-(].*//'`"
1390		exit ;;
	1504	DRAGONFLY_REL=`echo "$UNAME_RELEASE" \| sed -e 's/[-(].*//'`
	1505	GUESS=$UNAME_MACHINE-unknown-dragonfly$DRAGONFLY_REL
	1506	;;
1391	1507	:VMS::)
1392	1508	UNAME_MACHINE=`(uname -p) 2>/dev/null`
1393		case "$UNAME_MACHINE" in
1394		A*) echo alpha-dec-vms ; exit ;;
1395		I*) echo ia64-dec-vms ; exit ;;
1396		V*) echo vax-dec-vms ; exit ;;
	1509	case $UNAME_MACHINE in
	1510	A*) GUESS=alpha-dec-vms ;;
	1511	I*) GUESS=ia64-dec-vms ;;
	1512	V*) GUESS=vax-dec-vms ;;
1397	1513	esac ;;
1398	1514	:XENIX::SysV)
1399		echo i386-pc-xenix
1400		exit ;;
	1515	GUESS=i386-pc-xenix
	1516	;;
1401	1517	i86:skyos::*)
1402		echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" \| sed -e 's/ .*$//'`"
1403		exit ;;
	1518	SKYOS_REL=`echo "$UNAME_RELEASE" \| sed -e 's/ .*$//'`
	1519	GUESS=$UNAME_MACHINE-pc-skyos$SKYOS_REL
	1520	;;
1404	1521	i86:rdos::*)
1405		echo "$UNAME_MACHINE"-pc-rdos
1406		exit ;;
1407		i86:AROS::*)
1408		echo "$UNAME_MACHINE"-pc-aros
1409		exit ;;
	1522	GUESS=$UNAME_MACHINE-pc-rdos
	1523	;;
	1524	:AROS::*)
	1525	GUESS=$UNAME_MACHINE-unknown-aros
	1526	;;
1410	1527	x86_64:VMkernel::)
1411		echo "$UNAME_MACHINE"-unknown-esx
1412		exit ;;
	1528	GUESS=$UNAME_MACHINE-unknown-esx
	1529	;;
1413	1530	amd64:Isilon\ OneFS::)
1414		echo x86_64-unknown-onefs
1415		exit ;;
	1531	GUESS=x86_64-unknown-onefs
	1532	;;
	1533	:Unleashed::*)
	1534	GUESS=$UNAME_MACHINE-unknown-unleashed$UNAME_RELEASE
	1535	;;
1416	1536	esac
1417	1537
	1538	# Do we have a guess based on uname results?
	1539	if test "x$GUESS" != x; then
	1540	echo "$GUESS"
	1541	exit
	1542	fi
	1543
	1544	# No uname command or uname output not recognized.
	1545	set_cc_for_build
	1546	cat > "$dummy.c" <<EOF
	1547	#ifdef _SEQUENT_
	1548	#include <sys/types.h>
	1549	#include <sys/utsname.h>
	1550	#endif
	1551	#if defined(ultrix) \|\| defined(_ultrix) \|\| defined(__ultrix) \|\| defined(__ultrix__)
	1552	#if defined (vax) \|\| defined (__vax) \|\| defined (__vax__) \|\| defined(mips) \|\| defined(__mips) \|\| defined(__mips__) \|\| defined(MIPS) \|\| defined(__MIPS__)
	1553	#include <signal.h>
	1554	#if defined(_SIZE_T_) \|\| defined(SIGLOST)
	1555	#include <sys/utsname.h>
	1556	#endif
	1557	#endif
	1558	#endif
	1559	main ()
	1560	{
	1561	#if defined (sony)
	1562	#if defined (MIPSEB)
	1563	/* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
	1564	I don't know.... */
	1565	printf ("mips-sony-bsd\n"); exit (0);
	1566	#else
	1567	#include <sys/param.h>
	1568	printf ("m68k-sony-newsos%s\n",
	1569	#ifdef NEWSOS4
	1570	"4"
	1571	#else
	1572	""
	1573	#endif
	1574	); exit (0);
	1575	#endif
	1576	#endif
	1577
	1578	#if defined (NeXT)
	1579	#if !defined (__ARCHITECTURE__)
	1580	#define __ARCHITECTURE__ "m68k"
	1581	#endif
	1582	int version;
	1583	version=`(hostinfo \| sed -n 's/.NeXT Mach $[0-9]$.*/\1/p') 2>/dev/null`;
	1584	if (version < 4)
	1585	printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
	1586	else
	1587	printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
	1588	exit (0);
	1589	#endif
	1590
	1591	#if defined (MULTIMAX) \|\| defined (n16)
	1592	#if defined (UMAXV)
	1593	printf ("ns32k-encore-sysv\n"); exit (0);
	1594	#else
	1595	#if defined (CMU)
	1596	printf ("ns32k-encore-mach\n"); exit (0);
	1597	#else
	1598	printf ("ns32k-encore-bsd\n"); exit (0);
	1599	#endif
	1600	#endif
	1601	#endif
	1602
	1603	#if defined (__386BSD__)
	1604	printf ("i386-pc-bsd\n"); exit (0);
	1605	#endif
	1606
	1607	#if defined (sequent)
	1608	#if defined (i386)
	1609	printf ("i386-sequent-dynix\n"); exit (0);
	1610	#endif
	1611	#if defined (ns32000)
	1612	printf ("ns32k-sequent-dynix\n"); exit (0);
	1613	#endif
	1614	#endif
	1615
	1616	#if defined (_SEQUENT_)
	1617	struct utsname un;
	1618
	1619	uname(&un);
	1620	if (strncmp(un.version, "V2", 2) == 0) {
	1621	printf ("i386-sequent-ptx2\n"); exit (0);
	1622	}
	1623	if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
	1624	printf ("i386-sequent-ptx1\n"); exit (0);
	1625	}
	1626	printf ("i386-sequent-ptx\n"); exit (0);
	1627	#endif
	1628
	1629	#if defined (vax)
	1630	#if !defined (ultrix)
	1631	#include <sys/param.h>
	1632	#if defined (BSD)
	1633	#if BSD == 43
	1634	printf ("vax-dec-bsd4.3\n"); exit (0);
	1635	#else
	1636	#if BSD == 199006
	1637	printf ("vax-dec-bsd4.3reno\n"); exit (0);
	1638	#else
	1639	printf ("vax-dec-bsd\n"); exit (0);
	1640	#endif
	1641	#endif
	1642	#else
	1643	printf ("vax-dec-bsd\n"); exit (0);
	1644	#endif
	1645	#else
	1646	#if defined(_SIZE_T_) \|\| defined(SIGLOST)
	1647	struct utsname un;
	1648	uname (&un);
	1649	printf ("vax-dec-ultrix%s\n", un.release); exit (0);
	1650	#else
	1651	printf ("vax-dec-ultrix\n"); exit (0);
	1652	#endif
	1653	#endif
	1654	#endif
	1655	#if defined(ultrix) \|\| defined(_ultrix) \|\| defined(__ultrix) \|\| defined(__ultrix__)
	1656	#if defined(mips) \|\| defined(__mips) \|\| defined(__mips__) \|\| defined(MIPS) \|\| defined(__MIPS__)
	1657	#if defined(_SIZE_T_) \|\| defined(SIGLOST)
	1658	struct utsname *un;
	1659	uname (&un);
	1660	printf ("mips-dec-ultrix%s\n", un.release); exit (0);
	1661	#else
	1662	printf ("mips-dec-ultrix\n"); exit (0);
	1663	#endif
	1664	#endif
	1665	#endif
	1666
	1667	#if defined (alliant) && defined (i860)
	1668	printf ("i860-alliant-bsd\n"); exit (0);
	1669	#endif
	1670
	1671	exit (1);
	1672	}
	1673	EOF
	1674
	1675	$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`"$dummy"` &&
	1676	{ echo "$SYSTEM_NAME"; exit; }
	1677
	1678	# Apollos put the system type in the environment.
	1679	test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; }
	1680
1418	1681	echo "$0: unable to guess system type" >&2
1419	1682
1420		case "$UNAME_MACHINE:$UNAME_SYSTEM" in
	1683	case $UNAME_MACHINE:$UNAME_SYSTEM in
1421	1684	mips:Linux \| mips64:Linux)
1422	1685	# If we got here on MIPS GNU/Linux, output extra information.
1423	1686	cat >&2 <<EOF

1434	1697	operating system you are using. If your script is old, overwrite all
1435	1698	copies of config.guess and config.sub with the latest versions from:
1436	1699
1437		https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
	1700	https://git.savannah.gnu.org/cgit/config.git/plain/config.guess
1438	1701	and
1439		https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
	1702	https://git.savannah.gnu.org/cgit/config.git/plain/config.sub
	1703	EOF
	1704
	1705	our_year=`echo $timestamp \| sed 's,-.*,,'`
	1706	thisyear=`date +%Y`
	1707	# shellcheck disable=SC2003
	1708	script_age=`expr "$thisyear" - "$our_year"`
	1709	if test "$script_age" -lt 3 ; then
	1710	cat >&2 <<EOF
1440	1711
1441	1712	If $0 has already been updated, send the following data and any
1442	1713	information you think might be pertinent to config-patches@gnu.org to

1464	1735	UNAME_SYSTEM = "$UNAME_SYSTEM"
1465	1736	UNAME_VERSION = "$UNAME_VERSION"
1466	1737	EOF
	1738	fi
1467	1739
1468	1740	exit 1
1469	1741

+1526

-1454

autosetup/autosetup-config.sub less more

0	0	#! /bin/sh
1	1	# Configuration validation subroutine script.
2		# Copyright 1992-2018 Free Software Foundation, Inc.
3
4		timestamp='2018-03-08'
	2	# Copyright 1992-2021 Free Software Foundation, Inc.
	3
	4	# shellcheck disable=SC2006,SC2268 # see below for rationale
	5
	6	timestamp='2021-07-03'
5	7
6	8	# This file is free software; you can redistribute it and/or modify it
7	9	# under the terms of the GNU General Public License as published by

32	34	# Otherwise, we print the canonical config type on stdout and succeed.
33	35
34	36	# You can get the latest version of this script from:
35		# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
	37	# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub
36	38
37	39	# This file is supposed to be the same for all GNU packages
38	40	# and recognize all the CPU types, system types and aliases

49	51	# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
50	52	# It is wrong to echo any other type of specification.
51	53
	54	# The "shellcheck disable" line above the timestamp inhibits complaints
	55	# about features and limitations of the classic Bourne shell that were
	56	# superseded or lifted in POSIX. However, this script identifies a wide
	57	# variety of pre-POSIX systems that do not have POSIX shells at all, and
	58	# even some reasonably current systems (Solaris 10 as case-in-point) still
	59	# have a pre-POSIX /bin/sh.
	60
52	61	me=`echo "$0" \| sed -e 's,.*/,,'`
53	62
54	63	usage="\

66	75	version="\
67	76	GNU config.sub ($timestamp)
68	77
69		Copyright 1992-2018 Free Software Foundation, Inc.
	78	Copyright 1992-2021 Free Software Foundation, Inc.
70	79
71	80	This is free software; see the source for copying conditions. There is NO
72	81	warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."

88	97	- ) # Use stdin as input.
89	98	break ;;
90	99	-* )
91		echo "$me: invalid option $1$help"
	100	echo "$me: invalid option $1$help" >&2
92	101	exit 1 ;;
93	102
94	103	local)

109	118	exit 1;;
110	119	esac
111	120
112		# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
113		# Here we must recognize all the valid KERNEL-OS combinations.
114		maybe_os=`echo "$1" \| sed 's/^$.$-$[^-]-[^-]*$$/\2/'`
115		case $maybe_os in
116		nto-qnx* \| linux-gnu* \| linux-android* \| linux-dietlibc \| linux-newlib* \| \
117		linux-musl* \| linux-uclibc* \| uclinux-uclibc* \| uclinux-gnu* \| kfreebsd-gnu \| \
118		knetbsd-gnu \| netbsd-gnu \| netbsd-eabi \| \
119		kopensolaris-gnu \| cloudabi-eabi \| \
120		storm-chaos* \| os2-emx* \| rtmk-nova*)
121		os=-$maybe_os
122		basic_machine=`echo "$1" \| sed 's/^$.$-$[^-]-[^-]*$$/\1/'`
123		;;
124		android-linux)
125		os=-linux-android
126		basic_machine=`echo "$1" \| sed 's/^$.$-$[^-]-[^-]*$$/\1/'`-unknown
127		;;
128		*)
129		basic_machine=`echo "$1" \| sed 's/-[^-]*$//'`
130		if [ "$basic_machine" != "$1" ]
131		then os=`echo "$1" \| sed 's/.*-/-/'`
132		else os=; fi
133		;;
	121	# Split fields of configuration type
	122	# shellcheck disable=SC2162
	123	IFS="-" read field1 field2 field3 field4 <<EOF
	124	$1
	125	EOF
	126
	127	# Separate into logical components for further validation
	128	case $1 in
	129	----*)
	130	echo Invalid configuration \`"$1"\': more than four components >&2
	131	exit 1
	132	;;
	133	---)
	134	basic_machine=$field1-$field2
	135	basic_os=$field3-$field4
	136	;;
	137	--*)
	138	# Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two
	139	# parts
	140	maybe_os=$field2-$field3
	141	case $maybe_os in
	142	nto-qnx* \| linux-* \| uclinux-uclibc* \
	143	\| uclinux-gnu* \| kfreebsd-gnu \| knetbsd-gnu \| netbsd-gnu \
	144	\| netbsd-eabi \| kopensolaris-gnu \| cloudabi-eabi \
	145	\| storm-chaos* \| os2-emx* \| rtmk-nova*)
	146	basic_machine=$field1
	147	basic_os=$maybe_os
	148	;;
	149	android-linux)
	150	basic_machine=$field1-unknown
	151	basic_os=linux-android
	152	;;
	153	*)
	154	basic_machine=$field1-$field2
	155	basic_os=$field3
	156	;;
	157	esac
	158	;;
	159	-)
	160	# A lone config we happen to match not fitting any pattern
	161	case $field1-$field2 in
	162	decstation-3100)
	163	basic_machine=mips-dec
	164	basic_os=
	165	;;
	166	-)
	167	# Second component is usually, but not always the OS
	168	case $field2 in
	169	# Prevent following clause from handling this valid os
	170	sunos)
	171	basic_machine=$field1
	172	basic_os=$field2
	173	;;
	174	# Manufacturers
	175	dec* \| mips* \| sequent* \| encore* \| pc533* \| sgi* \| sony* \
	176	\| att* \| 7300* \| 3300* \| delta* \| motorola* \| sun[234]* \
	177	\| unicom* \| ibm* \| next \| hp \| isi* \| apollo \| altos* \
	178	\| convergent* \| ncr* \| news \| 32* \| 3600* \| 3100* \
	179	\| hitachi* \| c[123]* \| convex* \| sun \| crds \| omron* \| dg \
	180	\| ultra \| tti* \| harris \| dolphin \| highlevel \| gould \
	181	\| cbm \| ns \| masscomp \| apple \| axis \| knuth \| cray \
	182	\| microblaze* \| sim \| cisco \
	183	\| oki \| wec \| wrs \| winbond)
	184	basic_machine=$field1-$field2
	185	basic_os=
	186	;;
	187	*)
	188	basic_machine=$field1
	189	basic_os=$field2
	190	;;
	191	esac
	192	;;
	193	esac
	194	;;
	195	*)
	196	# Convert single-component short-hands not valid as part of
	197	# multi-component configurations.
	198	case $field1 in
	199	386bsd)
	200	basic_machine=i386-pc
	201	basic_os=bsd
	202	;;
	203	a29khif)
	204	basic_machine=a29k-amd
	205	basic_os=udi
	206	;;
	207	adobe68k)
	208	basic_machine=m68010-adobe
	209	basic_os=scout
	210	;;
	211	alliant)
	212	basic_machine=fx80-alliant
	213	basic_os=
	214	;;
	215	altos \| altos3068)
	216	basic_machine=m68k-altos
	217	basic_os=
	218	;;
	219	am29k)
	220	basic_machine=a29k-none
	221	basic_os=bsd
	222	;;
	223	amdahl)
	224	basic_machine=580-amdahl
	225	basic_os=sysv
	226	;;
	227	amiga)
	228	basic_machine=m68k-unknown
	229	basic_os=
	230	;;
	231	amigaos \| amigados)
	232	basic_machine=m68k-unknown
	233	basic_os=amigaos
	234	;;
	235	amigaunix \| amix)
	236	basic_machine=m68k-unknown
	237	basic_os=sysv4
	238	;;
	239	apollo68)
	240	basic_machine=m68k-apollo
	241	basic_os=sysv
	242	;;
	243	apollo68bsd)
	244	basic_machine=m68k-apollo
	245	basic_os=bsd
	246	;;
	247	aros)
	248	basic_machine=i386-pc
	249	basic_os=aros
	250	;;
	251	aux)
	252	basic_machine=m68k-apple
	253	basic_os=aux
	254	;;
	255	balance)
	256	basic_machine=ns32k-sequent
	257	basic_os=dynix
	258	;;
	259	blackfin)
	260	basic_machine=bfin-unknown
	261	basic_os=linux
	262	;;
	263	cegcc)
	264	basic_machine=arm-unknown
	265	basic_os=cegcc
	266	;;
	267	convex-c1)
	268	basic_machine=c1-convex
	269	basic_os=bsd
	270	;;
	271	convex-c2)
	272	basic_machine=c2-convex
	273	basic_os=bsd
	274	;;
	275	convex-c32)
	276	basic_machine=c32-convex
	277	basic_os=bsd
	278	;;
	279	convex-c34)
	280	basic_machine=c34-convex
	281	basic_os=bsd
	282	;;
	283	convex-c38)
	284	basic_machine=c38-convex
	285	basic_os=bsd
	286	;;
	287	cray)
	288	basic_machine=j90-cray
	289	basic_os=unicos
	290	;;
	291	crds \| unos)
	292	basic_machine=m68k-crds
	293	basic_os=
	294	;;
	295	da30)
	296	basic_machine=m68k-da30
	297	basic_os=
	298	;;
	299	decstation \| pmax \| pmin \| dec3100 \| decstatn)
	300	basic_machine=mips-dec
	301	basic_os=
	302	;;
	303	delta88)
	304	basic_machine=m88k-motorola
	305	basic_os=sysv3
	306	;;
	307	dicos)
	308	basic_machine=i686-pc
	309	basic_os=dicos
	310	;;
	311	djgpp)
	312	basic_machine=i586-pc
	313	basic_os=msdosdjgpp
	314	;;
	315	ebmon29k)
	316	basic_machine=a29k-amd
	317	basic_os=ebmon
	318	;;
	319	es1800 \| OSE68k \| ose68k \| ose \| OSE)
	320	basic_machine=m68k-ericsson
	321	basic_os=ose
	322	;;
	323	gmicro)
	324	basic_machine=tron-gmicro
	325	basic_os=sysv
	326	;;
	327	go32)
	328	basic_machine=i386-pc
	329	basic_os=go32
	330	;;
	331	h8300hms)
	332	basic_machine=h8300-hitachi
	333	basic_os=hms
	334	;;
	335	h8300xray)
	336	basic_machine=h8300-hitachi
	337	basic_os=xray
	338	;;
	339	h8500hms)
	340	basic_machine=h8500-hitachi
	341	basic_os=hms
	342	;;
	343	harris)
	344	basic_machine=m88k-harris
	345	basic_os=sysv3
	346	;;
	347	hp300 \| hp300hpux)
	348	basic_machine=m68k-hp
	349	basic_os=hpux
	350	;;
	351	hp300bsd)
	352	basic_machine=m68k-hp
	353	basic_os=bsd
	354	;;
	355	hppaosf)
	356	basic_machine=hppa1.1-hp
	357	basic_os=osf
	358	;;
	359	hppro)
	360	basic_machine=hppa1.1-hp
	361	basic_os=proelf
	362	;;
	363	i386mach)
	364	basic_machine=i386-mach
	365	basic_os=mach
	366	;;
	367	isi68 \| isi)
	368	basic_machine=m68k-isi
	369	basic_os=sysv
	370	;;
	371	m68knommu)
	372	basic_machine=m68k-unknown
	373	basic_os=linux
	374	;;
	375	magnum \| m3230)
	376	basic_machine=mips-mips
	377	basic_os=sysv
	378	;;
	379	merlin)
	380	basic_machine=ns32k-utek
	381	basic_os=sysv
	382	;;
	383	mingw64)
	384	basic_machine=x86_64-pc
	385	basic_os=mingw64
	386	;;
	387	mingw32)
	388	basic_machine=i686-pc
	389	basic_os=mingw32
	390	;;
	391	mingw32ce)
	392	basic_machine=arm-unknown
	393	basic_os=mingw32ce
	394	;;
	395	monitor)
	396	basic_machine=m68k-rom68k
	397	basic_os=coff
	398	;;
	399	morphos)
	400	basic_machine=powerpc-unknown
	401	basic_os=morphos
	402	;;
	403	moxiebox)
	404	basic_machine=moxie-unknown
	405	basic_os=moxiebox
	406	;;
	407	msdos)
	408	basic_machine=i386-pc
	409	basic_os=msdos
	410	;;
	411	msys)
	412	basic_machine=i686-pc
	413	basic_os=msys
	414	;;
	415	mvs)
	416	basic_machine=i370-ibm
	417	basic_os=mvs
	418	;;
	419	nacl)
	420	basic_machine=le32-unknown
	421	basic_os=nacl
	422	;;
	423	ncr3000)
	424	basic_machine=i486-ncr
	425	basic_os=sysv4
	426	;;
	427	netbsd386)
	428	basic_machine=i386-pc
	429	basic_os=netbsd
	430	;;
	431	netwinder)
	432	basic_machine=armv4l-rebel
	433	basic_os=linux
	434	;;
	435	news \| news700 \| news800 \| news900)
	436	basic_machine=m68k-sony
	437	basic_os=newsos
	438	;;
	439	news1000)
	440	basic_machine=m68030-sony
	441	basic_os=newsos
	442	;;
	443	necv70)
	444	basic_machine=v70-nec
	445	basic_os=sysv
	446	;;
	447	nh3000)
	448	basic_machine=m68k-harris
	449	basic_os=cxux
	450	;;
	451	nh[45]000)
	452	basic_machine=m88k-harris
	453	basic_os=cxux
	454	;;
	455	nindy960)
	456	basic_machine=i960-intel
	457	basic_os=nindy
	458	;;
	459	mon960)
	460	basic_machine=i960-intel
	461	basic_os=mon960
	462	;;
	463	nonstopux)
	464	basic_machine=mips-compaq
	465	basic_os=nonstopux
	466	;;
	467	os400)
	468	basic_machine=powerpc-ibm
	469	basic_os=os400
	470	;;
	471	OSE68000 \| ose68000)
	472	basic_machine=m68000-ericsson
	473	basic_os=ose
	474	;;
	475	os68k)
	476	basic_machine=m68k-none
	477	basic_os=os68k
	478	;;
	479	paragon)
	480	basic_machine=i860-intel
	481	basic_os=osf
	482	;;
	483	parisc)
	484	basic_machine=hppa-unknown
	485	basic_os=linux
	486	;;
	487	psp)
	488	basic_machine=mipsallegrexel-sony
	489	basic_os=psp
	490	;;
	491	pw32)
	492	basic_machine=i586-unknown
	493	basic_os=pw32
	494	;;
	495	rdos \| rdos64)
	496	basic_machine=x86_64-pc
	497	basic_os=rdos
	498	;;
	499	rdos32)
	500	basic_machine=i386-pc
	501	basic_os=rdos
	502	;;
	503	rom68k)
	504	basic_machine=m68k-rom68k
	505	basic_os=coff
	506	;;
	507	sa29200)
	508	basic_machine=a29k-amd
	509	basic_os=udi
	510	;;
	511	sei)
	512	basic_machine=mips-sei
	513	basic_os=seiux
	514	;;
	515	sequent)
	516	basic_machine=i386-sequent
	517	basic_os=
	518	;;
	519	sps7)
	520	basic_machine=m68k-bull
	521	basic_os=sysv2
	522	;;
	523	st2000)
	524	basic_machine=m68k-tandem
	525	basic_os=
	526	;;
	527	stratus)
	528	basic_machine=i860-stratus
	529	basic_os=sysv4
	530	;;
	531	sun2)
	532	basic_machine=m68000-sun
	533	basic_os=
	534	;;
	535	sun2os3)
	536	basic_machine=m68000-sun
	537	basic_os=sunos3
	538	;;
	539	sun2os4)
	540	basic_machine=m68000-sun
	541	basic_os=sunos4
	542	;;
	543	sun3)
	544	basic_machine=m68k-sun
	545	basic_os=
	546	;;
	547	sun3os3)
	548	basic_machine=m68k-sun
	549	basic_os=sunos3
	550	;;
	551	sun3os4)
	552	basic_machine=m68k-sun
	553	basic_os=sunos4
	554	;;
	555	sun4)
	556	basic_machine=sparc-sun
	557	basic_os=
	558	;;
	559	sun4os3)
	560	basic_machine=sparc-sun
	561	basic_os=sunos3
	562	;;
	563	sun4os4)
	564	basic_machine=sparc-sun
	565	basic_os=sunos4
	566	;;
	567	sun4sol2)
	568	basic_machine=sparc-sun
	569	basic_os=solaris2
	570	;;
	571	sun386 \| sun386i \| roadrunner)
	572	basic_machine=i386-sun
	573	basic_os=
	574	;;
	575	sv1)
	576	basic_machine=sv1-cray
	577	basic_os=unicos
	578	;;
	579	symmetry)
	580	basic_machine=i386-sequent
	581	basic_os=dynix
	582	;;
	583	t3e)
	584	basic_machine=alphaev5-cray
	585	basic_os=unicos
	586	;;
	587	t90)
	588	basic_machine=t90-cray
	589	basic_os=unicos
	590	;;
	591	toad1)
	592	basic_machine=pdp10-xkl
	593	basic_os=tops20
	594	;;
	595	tpf)
	596	basic_machine=s390x-ibm
	597	basic_os=tpf
	598	;;
	599	udi29k)
	600	basic_machine=a29k-amd
	601	basic_os=udi
	602	;;
	603	ultra3)
	604	basic_machine=a29k-nyu
	605	basic_os=sym1
	606	;;
	607	v810 \| necv810)
	608	basic_machine=v810-nec
	609	basic_os=none
	610	;;
	611	vaxv)
	612	basic_machine=vax-dec
	613	basic_os=sysv
	614	;;
	615	vms)
	616	basic_machine=vax-dec
	617	basic_os=vms
	618	;;
	619	vsta)
	620	basic_machine=i386-pc
	621	basic_os=vsta
	622	;;
	623	vxworks960)
	624	basic_machine=i960-wrs
	625	basic_os=vxworks
	626	;;
	627	vxworks68)
	628	basic_machine=m68k-wrs
	629	basic_os=vxworks
	630	;;
	631	vxworks29k)
	632	basic_machine=a29k-wrs
	633	basic_os=vxworks
	634	;;
	635	xbox)
	636	basic_machine=i686-pc
	637	basic_os=mingw32
	638	;;
	639	ymp)
	640	basic_machine=ymp-cray
	641	basic_os=unicos
	642	;;
	643	*)
	644	basic_machine=$1
	645	basic_os=
	646	;;
	647	esac
	648	;;
134	649	esac
135	650
136		### Let's recognize common machines as not being operating systems so
137		### that things like config.sub decstation-3100 work. We also
138		### recognize some manufacturers as not being operating systems, so we
139		### can provide default operating systems below.
140		case $os in
141		-sunos)
142		# Prevent following clause from handling this invalid input.
143		;;
144		-dec* \| -mips* \| -sequent* \| -encore* \| -pc532* \| -sgi* \| -sony* \| \
145		-att* \| -7300* \| -3300* \| -delta* \| -motorola* \| -sun[234]* \| \
146		-unicom* \| -ibm* \| -next \| -hp \| -isi* \| -apollo \| -altos* \| \
147		-convergent* \| -ncr* \| -news \| -32* \| -3600* \| -3100* \| -hitachi* \|\
148		-c[123]* \| -convex* \| -sun \| -crds \| -omron* \| -dg \| -ultra \| -tti* \| \
149		-harris \| -dolphin \| -highlevel \| -gould \| -cbm \| -ns \| -masscomp \| \
150		-apple \| -axis \| -knuth \| -cray \| -microblaze*)
151		os=
152		basic_machine=$1
153		;;
154		-bluegene*)
155		os=-cnk
156		;;
157		-sim \| -cisco \| -oki \| -wec \| -winbond)
158		os=
159		basic_machine=$1
160		;;
161		-scout)
162		;;
163		-wrs)
164		os=-vxworks
165		basic_machine=$1
166		;;
167		-chorusos*)
168		os=-chorusos
169		basic_machine=$1
170		;;
171		-chorusrdb)
172		os=-chorusrdb
173		basic_machine=$1
174		;;
175		-hiux*)
176		os=-hiuxwe2
177		;;
178		-sco6)
179		os=-sco5v6
180		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
181		;;
182		-sco5)
183		os=-sco3.2v5
184		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
185		;;
186		-sco4)
187		os=-sco3.2v4
188		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
189		;;
190		-sco3.2.[4-9]*)
191		os=`echo $os \| sed -e 's/sco3.2./sco3.2v/'`
192		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
193		;;
194		-sco3.2v[4-9]*)
195		# Don't forget version if it is 3.2v4 or newer.
196		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
197		;;
198		-sco5v6*)
199		# Don't forget version if it is 3.2v4 or newer.
200		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
201		;;
202		-sco*)
203		os=-sco3.2v2
204		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
205		;;
206		-udk*)
207		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
208		;;
209		-isc)
210		os=-isc2.2
211		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
212		;;
213		-clix*)
214		basic_machine=clipper-intergraph
215		;;
216		-isc*)
217		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-pc/'`
218		;;
219		-lynx*178)
220		os=-lynxos178
221		;;
222		-lynx*5)
223		os=-lynxos5
224		;;
225		-lynx*)
226		os=-lynxos
227		;;
228		-ptx*)
229		basic_machine=`echo "$1" \| sed -e 's/86-.*/86-sequent/'`
230		;;
231		-psos*)
232		os=-psos
233		;;
234		-mint \| -mint[0-9]*)
235		basic_machine=m68k-atari
236		os=-mint
237		;;
238		esac
239
240		# Decode aliases for certain CPU-COMPANY combinations.
	651	# Decode 1-component or ad-hoc basic machines
241	652	case $basic_machine in
242		# Recognize the basic CPU types without company name.
243		# Some are omitted here because they have special meanings below.
244		1750a \| 580 \
245		\| a29k \
246		\| aarch64 \| aarch64_be \
247		\| alpha \| alphaev[4-8] \| alphaev56 \| alphaev6[78] \| alphapca5[67] \
248		\| alpha64 \| alpha64ev[4-8] \| alpha64ev56 \| alpha64ev6[78] \| alpha64pca5[67] \
249		\| am33_2.0 \
250		\| arc \| arceb \
251		\| arm \| arm[bl]e \| arme[lb] \| armv[2-8] \| armv[3-8][lb] \| armv7[arm] \
252		\| avr \| avr32 \
253		\| ba \
254		\| be32 \| be64 \
255		\| bfin \
256		\| c4x \| c8051 \| clipper \
257		\| d10v \| d30v \| dlx \| dsp16xx \
258		\| e2k \| epiphany \
259		\| fido \| fr30 \| frv \| ft32 \
260		\| h8300 \| h8500 \| hppa \| hppa1.[01] \| hppa2.0 \| hppa2.0[nw] \| hppa64 \
261		\| hexagon \
262		\| i370 \| i860 \| i960 \| ia16 \| ia64 \
263		\| ip2k \| iq2000 \
264		\| k1om \
265		\| le32 \| le64 \
266		\| lm32 \
267		\| m32c \| m32r \| m32rle \| m68000 \| m68k \| m88k \
268		\| maxq \| mb \| microblaze \| microblazeel \| mcore \| mep \| metag \
269		\| mips \| mipsbe \| mipseb \| mipsel \| mipsle \
270		\| mips16 \
271		\| mips64 \| mips64el \
272		\| mips64octeon \| mips64octeonel \
273		\| mips64orion \| mips64orionel \
274		\| mips64r5900 \| mips64r5900el \
275		\| mips64vr \| mips64vrel \
276		\| mips64vr4100 \| mips64vr4100el \
277		\| mips64vr4300 \| mips64vr4300el \
278		\| mips64vr5000 \| mips64vr5000el \
279		\| mips64vr5900 \| mips64vr5900el \
280		\| mipsisa32 \| mipsisa32el \
281		\| mipsisa32r2 \| mipsisa32r2el \
282		\| mipsisa32r6 \| mipsisa32r6el \
283		\| mipsisa64 \| mipsisa64el \
284		\| mipsisa64r2 \| mipsisa64r2el \
285		\| mipsisa64r6 \| mipsisa64r6el \
286		\| mipsisa64sb1 \| mipsisa64sb1el \
287		\| mipsisa64sr71k \| mipsisa64sr71kel \
288		\| mipsr5900 \| mipsr5900el \
289		\| mipstx39 \| mipstx39el \
290		\| mn10200 \| mn10300 \
291		\| moxie \
292		\| mt \
293		\| msp430 \
294		\| nds32 \| nds32le \| nds32be \
295		\| nios \| nios2 \| nios2eb \| nios2el \
296		\| ns16k \| ns32k \
297		\| open8 \| or1k \| or1knd \| or32 \
298		\| pdp10 \| pj \| pjl \
299		\| powerpc \| powerpc64 \| powerpc64le \| powerpcle \
300		\| pru \
301		\| pyramid \
302		\| riscv32 \| riscv64 \
303		\| rl78 \| rx \
304		\| score \
305		\| sh \| sh[1234] \| sh[24]a \| sh[24]aeb \| sh[23]e \| sh[234]eb \| sheb \| shbe \| shle \| sh[1234]le \| sh3ele \
306		\| sh64 \| sh64le \
307		\| sparc \| sparc64 \| sparc64b \| sparc64v \| sparc86x \| sparclet \| sparclite \
308		\| sparcv8 \| sparcv9 \| sparcv9b \| sparcv9v \
309		\| spu \
310		\| tahoe \| tic4x \| tic54x \| tic55x \| tic6x \| tic80 \| tron \
311		\| ubicom32 \
312		\| v850 \| v850e \| v850e1 \| v850e2 \| v850es \| v850e2v3 \
313		\| visium \
314		\| wasm32 \
315		\| x86 \| xc16x \| xstormy16 \| xtensa \
316		\| z8k \| z80)
317		basic_machine=$basic_machine-unknown
318		;;
319		c54x)
320		basic_machine=tic54x-unknown
321		;;
322		c55x)
323		basic_machine=tic55x-unknown
324		;;
325		c6x)
326		basic_machine=tic6x-unknown
	653	# Here we handle the default manufacturer of certain CPU types. It is in
	654	# some cases the only manufacturer, in others, it is the most popular.
	655	w89k)
	656	cpu=hppa1.1
	657	vendor=winbond
	658	;;
	659	op50n)
	660	cpu=hppa1.1
	661	vendor=oki
	662	;;
	663	op60c)
	664	cpu=hppa1.1
	665	vendor=oki
	666	;;
	667	ibm*)
	668	cpu=i370
	669	vendor=ibm
	670	;;
	671	orion105)
	672	cpu=clipper
	673	vendor=highlevel
	674	;;
	675	mac \| mpw \| mac-mpw)
	676	cpu=m68k
	677	vendor=apple
	678	;;
	679	pmac \| pmac-mpw)
	680	cpu=powerpc
	681	vendor=apple
	682	;;
	683
	684	# Recognize the various machine names and aliases which stand
	685	# for a CPU type and a company and sometimes even an OS.
	686	3b1 \| 7300 \| 7300-att \| att-7300 \| pc7300 \| safari \| unixpc)
	687	cpu=m68000
	688	vendor=att
	689	;;
	690	3b*)
	691	cpu=we32k
	692	vendor=att
	693	;;
	694	bluegene*)
	695	cpu=powerpc
	696	vendor=ibm
	697	basic_os=cnk
	698	;;
	699	decsystem10* \| dec10*)
	700	cpu=pdp10
	701	vendor=dec
	702	basic_os=tops10
	703	;;
	704	decsystem20* \| dec20*)
	705	cpu=pdp10
	706	vendor=dec
	707	basic_os=tops20
	708	;;
	709	delta \| 3300 \| motorola-3300 \| motorola-delta \
	710	\| 3300-motorola \| delta-motorola)
	711	cpu=m68k
	712	vendor=motorola
	713	;;
	714	dpx2*)
	715	cpu=m68k
	716	vendor=bull
	717	basic_os=sysv3
	718	;;
	719	encore \| umax \| mmax)
	720	cpu=ns32k
	721	vendor=encore
	722	;;
	723	elxsi)
	724	cpu=elxsi
	725	vendor=elxsi
	726	basic_os=${basic_os:-bsd}
	727	;;
	728	fx2800)
	729	cpu=i860
	730	vendor=alliant
	731	;;
	732	genix)
	733	cpu=ns32k
	734	vendor=ns
	735	;;
	736	h3050r* \| hiux*)
	737	cpu=hppa1.1
	738	vendor=hitachi
	739	basic_os=hiuxwe2
	740	;;
	741	hp3k9[0-9][0-9] \| hp9[0-9][0-9])
	742	cpu=hppa1.0
	743	vendor=hp
	744	;;
	745	hp9k2[0-9][0-9] \| hp9k31[0-9])
	746	cpu=m68000
	747	vendor=hp
	748	;;
	749	hp9k3[2-9][0-9])
	750	cpu=m68k
	751	vendor=hp
	752	;;
	753	hp9k6[0-9][0-9] \| hp6[0-9][0-9])
	754	cpu=hppa1.0
	755	vendor=hp
	756	;;
	757	hp9k7[0-79][0-9] \| hp7[0-79][0-9])
	758	cpu=hppa1.1
	759	vendor=hp
	760	;;
	761	hp9k78[0-9] \| hp78[0-9])
	762	# FIXME: really hppa2.0-hp
	763	cpu=hppa1.1
	764	vendor=hp
	765	;;
	766	hp9k8[67]1 \| hp8[67]1 \| hp9k80[24] \| hp80[24] \| hp9k8[78]9 \| hp8[78]9 \| hp9k893 \| hp893)
	767	# FIXME: really hppa2.0-hp
	768	cpu=hppa1.1
	769	vendor=hp
	770	;;
	771	hp9k8[0-9][13679] \| hp8[0-9][13679])
	772	cpu=hppa1.1
	773	vendor=hp
	774	;;
	775	hp9k8[0-9][0-9] \| hp8[0-9][0-9])
	776	cpu=hppa1.0
	777	vendor=hp
	778	;;
	779	i*86v32)
	780	cpu=`echo "$1" \| sed -e 's/86.*/86/'`
	781	vendor=pc
	782	basic_os=sysv32
	783	;;
	784	i86v4)
	785	cpu=`echo "$1" \| sed -e 's/86.*/86/'`
	786	vendor=pc
	787	basic_os=sysv4
	788	;;
	789	i*86v)
	790	cpu=`echo "$1" \| sed -e 's/86.*/86/'`
	791	vendor=pc
	792	basic_os=sysv
	793	;;
	794	i*86sol2)
	795	cpu=`echo "$1" \| sed -e 's/86.*/86/'`
	796	vendor=pc
	797	basic_os=solaris2
	798	;;
	799	j90 \| j90-cray)
	800	cpu=j90
	801	vendor=cray
	802	basic_os=${basic_os:-unicos}
	803	;;
	804	iris \| iris4d)
	805	cpu=mips
	806	vendor=sgi
	807	case $basic_os in
	808	irix*)
	809	;;
	810	*)
	811	basic_os=irix4
	812	;;
	813	esac
	814	;;
	815	miniframe)
	816	cpu=m68000
	817	vendor=convergent
	818	;;
	819	mint \| mint[0-9] \| MiNT \| MiNT[0-9]*)
	820	cpu=m68k
	821	vendor=atari
	822	basic_os=mint
	823	;;
	824	news-3600 \| risc-news)
	825	cpu=mips
	826	vendor=sony
	827	basic_os=newsos
	828	;;
	829	next \| m*-next)
	830	cpu=m68k
	831	vendor=next
	832	case $basic_os in
	833	openstep*)
	834	;;
	835	nextstep*)
	836	;;
	837	ns2*)
	838	basic_os=nextstep2
	839	;;
	840	*)
	841	basic_os=nextstep3
	842	;;
	843	esac
	844	;;
	845	np1)
	846	cpu=np1
	847	vendor=gould
	848	;;
	849	op50n-* \| op60c-*)
	850	cpu=hppa1.1
	851	vendor=oki
	852	basic_os=proelf
	853	;;
	854	pa-hitachi)
	855	cpu=hppa1.1
	856	vendor=hitachi
	857	basic_os=hiuxwe2
	858	;;
	859	pbd)
	860	cpu=sparc
	861	vendor=tti
	862	;;
	863	pbb)
	864	cpu=m68k
	865	vendor=tti
	866	;;
	867	pc532)
	868	cpu=ns32k
	869	vendor=pc532
	870	;;
	871	pn)
	872	cpu=pn
	873	vendor=gould
	874	;;
	875	power)
	876	cpu=power
	877	vendor=ibm
	878	;;
	879	ps2)
	880	cpu=i386
	881	vendor=ibm
	882	;;
	883	rm[46]00)
	884	cpu=mips
	885	vendor=siemens
	886	;;
	887	rtpc \| rtpc-*)
	888	cpu=romp
	889	vendor=ibm
	890	;;
	891	sde)
	892	cpu=mipsisa32
	893	vendor=sde
	894	basic_os=${basic_os:-elf}
	895	;;
	896	simso-wrs)
	897	cpu=sparclite
	898	vendor=wrs
	899	basic_os=vxworks
	900	;;
	901	tower \| tower-32)
	902	cpu=m68k
	903	vendor=ncr
	904	;;
	905	vpp\|vx\|vx-)
	906	cpu=f301
	907	vendor=fujitsu
	908	;;
	909	w65)
	910	cpu=w65
	911	vendor=wdc
	912	;;
	913	w89k-*)
	914	cpu=hppa1.1
	915	vendor=winbond
	916	basic_os=proelf
	917	;;
	918	none)
	919	cpu=none
	920	vendor=none
327	921	;;
328	922	leon\|leon[3-9])
329		basic_machine=sparc-$basic_machine
330		;;
331		m6811 \| m68hc11 \| m6812 \| m68hc12 \| m68hcs12x \| nvptx \| picochip)
332		basic_machine=$basic_machine-unknown
333		os=-none
334		;;
335		m88110 \| m680[12346]0 \| m683?2 \| m68360 \| m5200 \| v70 \| w65)
336		;;
337		ms1)
338		basic_machine=mt-unknown
339		;;
340
341		strongarm \| thumb \| xscale)
342		basic_machine=arm-unknown
343		;;
344		xgate)
345		basic_machine=$basic_machine-unknown
346		os=-none
347		;;
348		xscaleeb)
349		basic_machine=armeb-unknown
350		;;
351
352		xscaleel)
353		basic_machine=armel-unknown
354		;;
355
	923	cpu=sparc
	924	vendor=$basic_machine
	925	;;
	926	leon-\|leon[3-9]-)
	927	cpu=sparc
	928	vendor=`echo "$basic_machine" \| sed 's/-.*//'`
	929	;;
	930
	931	-)
	932	# shellcheck disable=SC2162
	933	IFS="-" read cpu vendor <<EOF
	934	$basic_machine
	935	EOF
	936	;;
356	937	# We use `pc' rather than `unknown'
357	938	# because (1) that's what they normally are, and
358	939	# (2) the word "unknown" tends to confuse beginning users.
359	940	i*86 \| x86_64)
360		basic_machine=$basic_machine-pc
361		;;
362		# Object if more than one company name word.
363		--*)
364		echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2
365		exit 1
366		;;
367		# Recognize the basic CPU types with company name.
368		580-* \
369		\| a29k-* \
370		\| aarch64-* \| aarch64_be-* \
371		\| alpha-* \| alphaev[4-8]-* \| alphaev56-* \| alphaev6[78]-* \
372		\| alpha64-* \| alpha64ev[4-8]-* \| alpha64ev56-* \| alpha64ev6[78]-* \
373		\| alphapca5[67]-* \| alpha64pca5[67]-* \| arc-* \| arceb-* \
374		\| arm-* \| armbe-* \| armle-* \| armeb-* \| armv- \
375		\| avr-* \| avr32-* \
376		\| ba-* \
377		\| be32-* \| be64-* \
378		\| bfin-* \| bs2000-* \
379		\| c[123]* \| c30-* \| [cjt]90-* \| c4x-* \
380		\| c8051-* \| clipper-* \| craynv-* \| cydra-* \
381		\| d10v-* \| d30v-* \| dlx-* \
382		\| e2k-* \| elxsi-* \
383		\| f30[01]-* \| f700-* \| fido-* \| fr30-* \| frv-* \| fx80-* \
384		\| h8300-* \| h8500-* \
385		\| hppa-* \| hppa1.[01]-* \| hppa2.0-* \| hppa2.0[nw]-* \| hppa64-* \
386		\| hexagon-* \
387		\| i86- \| i860-* \| i960-* \| ia16-* \| ia64-* \
388		\| ip2k-* \| iq2000-* \
389		\| k1om-* \
390		\| le32-* \| le64-* \
391		\| lm32-* \
392		\| m32c-* \| m32r-* \| m32rle-* \
393		\| m68000-* \| m680[012346]0-* \| m68360-* \| m683?2-* \| m68k-* \
394		\| m88110-* \| m88k-* \| maxq-* \| mcore-* \| metag-* \
395		\| microblaze-* \| microblazeel-* \
396		\| mips-* \| mipsbe-* \| mipseb-* \| mipsel-* \| mipsle-* \
397		\| mips16-* \
398		\| mips64-* \| mips64el-* \
399		\| mips64octeon-* \| mips64octeonel-* \
400		\| mips64orion-* \| mips64orionel-* \
401		\| mips64r5900-* \| mips64r5900el-* \
402		\| mips64vr-* \| mips64vrel-* \
403		\| mips64vr4100-* \| mips64vr4100el-* \
404		\| mips64vr4300-* \| mips64vr4300el-* \
405		\| mips64vr5000-* \| mips64vr5000el-* \
406		\| mips64vr5900-* \| mips64vr5900el-* \
407		\| mipsisa32-* \| mipsisa32el-* \
408		\| mipsisa32r2-* \| mipsisa32r2el-* \
409		\| mipsisa32r6-* \| mipsisa32r6el-* \
410		\| mipsisa64-* \| mipsisa64el-* \
411		\| mipsisa64r2-* \| mipsisa64r2el-* \
412		\| mipsisa64r6-* \| mipsisa64r6el-* \
413		\| mipsisa64sb1-* \| mipsisa64sb1el-* \
414		\| mipsisa64sr71k-* \| mipsisa64sr71kel-* \
415		\| mipsr5900-* \| mipsr5900el-* \
416		\| mipstx39-* \| mipstx39el-* \
417		\| mmix-* \
418		\| mt-* \
419		\| msp430-* \
420		\| nds32-* \| nds32le-* \| nds32be-* \
421		\| nios-* \| nios2-* \| nios2eb-* \| nios2el-* \
422		\| none-* \| np1-* \| ns16k-* \| ns32k-* \
423		\| open8-* \
424		\| or1k- \
425		\| orion-* \
426		\| pdp10-* \| pdp11-* \| pj-* \| pjl-* \| pn-* \| power-* \
427		\| powerpc-* \| powerpc64-* \| powerpc64le-* \| powerpcle-* \
428		\| pru-* \
429		\| pyramid-* \
430		\| riscv32-* \| riscv64-* \
431		\| rl78-* \| romp-* \| rs6000-* \| rx-* \
432		\| sh-* \| sh[1234]-* \| sh[24]a-* \| sh[24]aeb-* \| sh[23]e-* \| sh[34]eb-* \| sheb-* \| shbe-* \
433		\| shle-* \| sh[1234]le-* \| sh3ele-* \| sh64-* \| sh64le-* \
434		\| sparc-* \| sparc64-* \| sparc64b-* \| sparc64v-* \| sparc86x-* \| sparclet-* \
435		\| sparclite-* \
436		\| sparcv8-* \| sparcv9-* \| sparcv9b-* \| sparcv9v-* \| sv1-* \| sx- \
437		\| tahoe-* \
438		\| tic30-* \| tic4x-* \| tic54x-* \| tic55x-* \| tic6x-* \| tic80-* \
439		\| tile- \
440		\| tron-* \
441		\| ubicom32-* \
442		\| v850-* \| v850e-* \| v850e1-* \| v850es-* \| v850e2-* \| v850e2v3-* \
443		\| vax-* \
444		\| visium-* \
445		\| wasm32-* \
446		\| we32k-* \
447		\| x86-* \| x86_64-* \| xc16x-* \| xps100-* \
448		\| xstormy16-* \| xtensa- \
449		\| ymp-* \
450		\| z8k-* \| z80-*)
451		;;
452		# Recognize the basic CPU types without company name, with glob match.
453		xtensa*)
454		basic_machine=$basic_machine-unknown
455		;;
456		# Recognize the various machine names and aliases which stand
457		# for a CPU type and a company and sometimes even an OS.
458		386bsd)
459		basic_machine=i386-pc
460		os=-bsd
461		;;
462		3b1 \| 7300 \| 7300-att \| att-7300 \| pc7300 \| safari \| unixpc)
463		basic_machine=m68000-att
464		;;
465		3b*)
466		basic_machine=we32k-att
467		;;
468		a29khif)
469		basic_machine=a29k-amd
470		os=-udi
471		;;
472		abacus)
473		basic_machine=abacus-unknown
474		;;
475		adobe68k)
476		basic_machine=m68010-adobe
477		os=-scout
478		;;
479		alliant \| fx80)
480		basic_machine=fx80-alliant
481		;;
482		altos \| altos3068)
483		basic_machine=m68k-altos
484		;;
485		am29k)
486		basic_machine=a29k-none
487		os=-bsd
488		;;
489		amd64)
490		basic_machine=x86_64-pc
491		;;
	941	cpu=$basic_machine
	942	vendor=pc
	943	;;
	944	# These rules are duplicated from below for sake of the special case above;
	945	# i.e. things that normalized to x86 arches should also default to "pc"
	946	pc98)
	947	cpu=i386
	948	vendor=pc
	949	;;
	950	x64 \| amd64)
	951	cpu=x86_64
	952	vendor=pc
	953	;;
	954	# Recognize the basic CPU types without company name.
	955	*)
	956	cpu=$basic_machine
	957	vendor=unknown
	958	;;
	959	esac
	960
	961	unset -v basic_machine
	962
	963	# Decode basic machines in the full and proper CPU-Company form.
	964	case $cpu-$vendor in
	965	# Here we handle the default manufacturer of certain CPU types in canonical form. It is in
	966	# some cases the only manufacturer, in others, it is the most popular.
	967	craynv-unknown)
	968	vendor=cray
	969	basic_os=${basic_os:-unicosmp}
	970	;;
	971	c90-unknown \| c90-cray)
	972	vendor=cray
	973	basic_os=${Basic_os:-unicos}
	974	;;
	975	fx80-unknown)
	976	vendor=alliant
	977	;;
	978	romp-unknown)
	979	vendor=ibm
	980	;;
	981	mmix-unknown)
	982	vendor=knuth
	983	;;
	984	microblaze-unknown \| microblazeel-unknown)
	985	vendor=xilinx
	986	;;
	987	rs6000-unknown)
	988	vendor=ibm
	989	;;
	990	vax-unknown)
	991	vendor=dec
	992	;;
	993	pdp11-unknown)
	994	vendor=dec
	995	;;
	996	we32k-unknown)
	997	vendor=att
	998	;;
	999	cydra-unknown)
	1000	vendor=cydrome
	1001	;;
	1002	i370-ibm*)
	1003	vendor=ibm
	1004	;;
	1005	orion-unknown)
	1006	vendor=highlevel
	1007	;;
	1008	xps-unknown \| xps100-unknown)
	1009	cpu=xps100
	1010	vendor=honeywell
	1011	;;
	1012
	1013	# Here we normalize CPU types with a missing or matching vendor
	1014	dpx20-unknown \| dpx20-bull)
	1015	cpu=rs6000
	1016	vendor=bull
	1017	basic_os=${basic_os:-bosx}
	1018	;;
	1019
	1020	# Here we normalize CPU types irrespective of the vendor
492	1021	amd64-*)
493		basic_machine=x86_64-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
494		;;
495		amdahl)
496		basic_machine=580-amdahl
497		os=-sysv
498		;;
499		amiga \| amiga-*)
500		basic_machine=m68k-unknown
501		;;
502		amigaos \| amigados)
503		basic_machine=m68k-unknown
504		os=-amigaos
505		;;
506		amigaunix \| amix)
507		basic_machine=m68k-unknown
508		os=-sysv4
509		;;
510		apollo68)
511		basic_machine=m68k-apollo
512		os=-sysv
513		;;
514		apollo68bsd)
515		basic_machine=m68k-apollo
516		os=-bsd
517		;;
518		aros)
519		basic_machine=i386-pc
520		os=-aros
521		;;
522		asmjs)
523		basic_machine=asmjs-unknown
524		;;
525		aux)
526		basic_machine=m68k-apple
527		os=-aux
528		;;
529		balance)
530		basic_machine=ns32k-sequent
531		os=-dynix
532		;;
533		blackfin)
534		basic_machine=bfin-unknown
535		os=-linux
	1022	cpu=x86_64
536	1023	;;
537	1024	blackfin-*)
538		basic_machine=bfin-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
539		os=-linux
540		;;
541		bluegene*)
542		basic_machine=powerpc-ibm
543		os=-cnk
	1025	cpu=bfin
	1026	basic_os=linux
544	1027	;;
545	1028	c54x-*)
546		basic_machine=tic54x-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
	1029	cpu=tic54x
547	1030	;;
548	1031	c55x-*)
549		basic_machine=tic55x-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
	1032	cpu=tic55x
550	1033	;;
551	1034	c6x-*)
552		basic_machine=tic6x-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
553		;;
554		c90)
555		basic_machine=c90-cray
556		os=-unicos
557		;;
558		cegcc)
559		basic_machine=arm-unknown
560		os=-cegcc
561		;;
562		convex-c1)
563		basic_machine=c1-convex
564		os=-bsd
565		;;
566		convex-c2)
567		basic_machine=c2-convex
568		os=-bsd
569		;;
570		convex-c32)
571		basic_machine=c32-convex
572		os=-bsd
573		;;
574		convex-c34)
575		basic_machine=c34-convex
576		os=-bsd
577		;;
578		convex-c38)
579		basic_machine=c38-convex
580		os=-bsd
581		;;
582		cray \| j90)
583		basic_machine=j90-cray
584		os=-unicos
585		;;
586		craynv)
587		basic_machine=craynv-cray
588		os=-unicosmp
589		;;
590		cr16 \| cr16-*)
591		basic_machine=cr16-unknown
592		os=-elf
593		;;
594		crds \| unos)
595		basic_machine=m68k-crds
596		;;
597		crisv32 \| crisv32-* \| etraxfs*)
598		basic_machine=crisv32-axis
599		;;
600		cris \| cris-* \| etrax*)
601		basic_machine=cris-axis
602		;;
603		crx)
604		basic_machine=crx-unknown
605		os=-elf
606		;;
607		da30 \| da30-*)
608		basic_machine=m68k-da30
609		;;
610		decstation \| decstation-3100 \| pmax \| pmax-* \| pmin \| dec3100 \| decstatn)
611		basic_machine=mips-dec
612		;;
613		decsystem10* \| dec10*)
614		basic_machine=pdp10-dec
615		os=-tops10
616		;;
617		decsystem20* \| dec20*)
618		basic_machine=pdp10-dec
619		os=-tops20
620		;;
621		delta \| 3300 \| motorola-3300 \| motorola-delta \
622		\| 3300-motorola \| delta-motorola)
623		basic_machine=m68k-motorola
624		;;
625		delta88)
626		basic_machine=m88k-motorola
627		os=-sysv3
628		;;
629		dicos)
630		basic_machine=i686-pc
631		os=-dicos
632		;;
633		djgpp)
634		basic_machine=i586-pc
635		os=-msdosdjgpp
636		;;
637		dpx20 \| dpx20-*)
638		basic_machine=rs6000-bull
639		os=-bosx
640		;;
641		dpx2*)
642		basic_machine=m68k-bull
643		os=-sysv3
644		;;
645		e500v[12])
646		basic_machine=powerpc-unknown
647		os=$os"spe"
	1035	cpu=tic6x
648	1036	;;
649	1037	e500v[12]-*)
650		basic_machine=powerpc-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
651		os=$os"spe"
652		;;
653		ebmon29k)
654		basic_machine=a29k-amd
655		os=-ebmon
656		;;
657		elxsi)
658		basic_machine=elxsi-elxsi
659		os=-bsd
660		;;
661		encore \| umax \| mmax)
662		basic_machine=ns32k-encore
663		;;
664		es1800 \| OSE68k \| ose68k \| ose \| OSE)
665		basic_machine=m68k-ericsson
666		os=-ose
667		;;
668		fx2800)
669		basic_machine=i860-alliant
670		;;
671		genix)
672		basic_machine=ns32k-ns
673		;;
674		gmicro)
675		basic_machine=tron-gmicro
676		os=-sysv
677		;;
678		go32)
679		basic_machine=i386-pc
680		os=-go32
681		;;
682		h3050r* \| hiux*)
683		basic_machine=hppa1.1-hitachi
684		os=-hiuxwe2
685		;;
686		h8300hms)
687		basic_machine=h8300-hitachi
688		os=-hms
689		;;
690		h8300xray)
691		basic_machine=h8300-hitachi
692		os=-xray
693		;;
694		h8500hms)
695		basic_machine=h8500-hitachi
696		os=-hms
697		;;
698		harris)
699		basic_machine=m88k-harris
700		os=-sysv3
701		;;
702		hp300-*)
703		basic_machine=m68k-hp
704		;;
705		hp300bsd)
706		basic_machine=m68k-hp
707		os=-bsd
708		;;
709		hp300hpux)
710		basic_machine=m68k-hp
711		os=-hpux
712		;;
713		hp3k9[0-9][0-9] \| hp9[0-9][0-9])
714		basic_machine=hppa1.0-hp
715		;;
716		hp9k2[0-9][0-9] \| hp9k31[0-9])
717		basic_machine=m68000-hp
718		;;
719		hp9k3[2-9][0-9])
720		basic_machine=m68k-hp
721		;;
722		hp9k6[0-9][0-9] \| hp6[0-9][0-9])
723		basic_machine=hppa1.0-hp
724		;;
725		hp9k7[0-79][0-9] \| hp7[0-79][0-9])
726		basic_machine=hppa1.1-hp
727		;;
728		hp9k78[0-9] \| hp78[0-9])
729		# FIXME: really hppa2.0-hp
730		basic_machine=hppa1.1-hp
731		;;
732		hp9k8[67]1 \| hp8[67]1 \| hp9k80[24] \| hp80[24] \| hp9k8[78]9 \| hp8[78]9 \| hp9k893 \| hp893)
733		# FIXME: really hppa2.0-hp
734		basic_machine=hppa1.1-hp
735		;;
736		hp9k8[0-9][13679] \| hp8[0-9][13679])
737		basic_machine=hppa1.1-hp
738		;;
739		hp9k8[0-9][0-9] \| hp8[0-9][0-9])
740		basic_machine=hppa1.0-hp
741		;;
742		hppaosf)
743		basic_machine=hppa1.1-hp
744		os=-osf
745		;;
746		hppro)
747		basic_machine=hppa1.1-hp
748		os=-proelf
749		;;
750		i370-ibm* \| ibm*)
751		basic_machine=i370-ibm
752		;;
753		i*86v32)
754		basic_machine=`echo "$1" \| sed -e 's/86.*/86-pc/'`
755		os=-sysv32
756		;;
757		i86v4)
758		basic_machine=`echo "$1" \| sed -e 's/86.*/86-pc/'`
759		os=-sysv4
760		;;
761		i*86v)
762		basic_machine=`echo "$1" \| sed -e 's/86.*/86-pc/'`
763		os=-sysv
764		;;
765		i*86sol2)
766		basic_machine=`echo "$1" \| sed -e 's/86.*/86-pc/'`
767		os=-solaris2
768		;;
769		i386mach)
770		basic_machine=i386-mach
771		os=-mach
772		;;
773		vsta)
774		basic_machine=i386-unknown
775		os=-vsta
776		;;
777		iris \| iris4d)
778		basic_machine=mips-sgi
779		case $os in
780		-irix*)
781		;;
782		*)
783		os=-irix4
784		;;
	1038	cpu=powerpc
	1039	basic_os=${basic_os}"spe"
	1040	;;
	1041	mips3-)
	1042	cpu=mips64
	1043	;;
	1044	ms1-*)
	1045	cpu=mt
	1046	;;
	1047	m68knommu-*)
	1048	cpu=m68k
	1049	basic_os=linux
	1050	;;
	1051	m9s12z-* \| m68hcs12z-* \| hcs12z-* \| s12z-*)
	1052	cpu=s12z
	1053	;;
	1054	openrisc-*)
	1055	cpu=or32
	1056	;;
	1057	parisc-*)
	1058	cpu=hppa
	1059	basic_os=linux
	1060	;;
	1061	pentium-* \| p5-* \| k5-* \| k6-* \| nexgen-* \| viac3-*)
	1062	cpu=i586
	1063	;;
	1064	pentiumpro-* \| p6-* \| 6x86-* \| athlon-* \| athalon_-)
	1065	cpu=i686
	1066	;;
	1067	pentiumii-* \| pentium2-* \| pentiumiii-* \| pentium3-*)
	1068	cpu=i686
	1069	;;
	1070	pentium4-*)
	1071	cpu=i786
	1072	;;
	1073	pc98-*)
	1074	cpu=i386
	1075	;;
	1076	ppc-* \| ppcbe-*)
	1077	cpu=powerpc
	1078	;;
	1079	ppcle-* \| powerpclittle-*)
	1080	cpu=powerpcle
	1081	;;
	1082	ppc64-*)
	1083	cpu=powerpc64
	1084	;;
	1085	ppc64le-* \| powerpc64little-*)
	1086	cpu=powerpc64le
	1087	;;
	1088	sb1-*)
	1089	cpu=mipsisa64sb1
	1090	;;
	1091	sb1el-*)
	1092	cpu=mipsisa64sb1el
	1093	;;
	1094	sh5e[lb]-*)
	1095	cpu=`echo "$cpu" \| sed 's/^$sh.$e$.$$/\1\2e/'`
	1096	;;
	1097	spur-*)
	1098	cpu=spur
	1099	;;
	1100	strongarm-* \| thumb-*)
	1101	cpu=arm
	1102	;;
	1103	tx39-*)
	1104	cpu=mipstx39
	1105	;;
	1106	tx39el-*)
	1107	cpu=mipstx39el
	1108	;;
	1109	x64-*)
	1110	cpu=x86_64
	1111	;;
	1112	xscale-* \| xscalee[bl]-*)
	1113	cpu=`echo "$cpu" \| sed 's/^xscale/arm/'`
	1114	;;
	1115	arm64-*)
	1116	cpu=aarch64
	1117	;;
	1118
	1119	# Recognize the canonical CPU Types that limit and/or modify the
	1120	# company names they are paired with.
	1121	cr16-*)
	1122	basic_os=${basic_os:-elf}
	1123	;;
	1124	crisv32-* \| etraxfs-)
	1125	cpu=crisv32
	1126	vendor=axis
	1127	;;
	1128	cris-* \| etrax-)
	1129	cpu=cris
	1130	vendor=axis
	1131	;;
	1132	crx-*)
	1133	basic_os=${basic_os:-elf}
	1134	;;
	1135	neo-tandem)
	1136	cpu=neo
	1137	vendor=tandem
	1138	;;
	1139	nse-tandem)
	1140	cpu=nse
	1141	vendor=tandem
	1142	;;
	1143	nsr-tandem)
	1144	cpu=nsr
	1145	vendor=tandem
	1146	;;
	1147	nsv-tandem)
	1148	cpu=nsv
	1149	vendor=tandem
	1150	;;
	1151	nsx-tandem)
	1152	cpu=nsx
	1153	vendor=tandem
	1154	;;
	1155	mipsallegrexel-sony)
	1156	cpu=mipsallegrexel
	1157	vendor=sony
	1158	;;
	1159	tile-)
	1160	basic_os=${basic_os:-linux-gnu}
	1161	;;
	1162
	1163	*)
	1164	# Recognize the canonical CPU types that are allowed with any
	1165	# company name.
	1166	case $cpu in
	1167	1750a \| 580 \
	1168	\| a29k \
	1169	\| aarch64 \| aarch64_be \
	1170	\| abacus \
	1171	\| alpha \| alphaev[4-8] \| alphaev56 \| alphaev6[78] \
	1172	\| alpha64 \| alpha64ev[4-8] \| alpha64ev56 \| alpha64ev6[78] \
	1173	\| alphapca5[67] \| alpha64pca5[67] \
	1174	\| am33_2.0 \
	1175	\| amdgcn \
	1176	\| arc \| arceb \| arc32 \| arc64 \
	1177	\| arm \| arm[lb]e \| arme[lb] \| armv* \
	1178	\| avr \| avr32 \
	1179	\| asmjs \
	1180	\| ba \
	1181	\| be32 \| be64 \
	1182	\| bfin \| bpf \| bs2000 \
	1183	\| c[123]* \| c30 \| [cjt]90 \| c4x \
	1184	\| c8051 \| clipper \| craynv \| csky \| cydra \
	1185	\| d10v \| d30v \| dlx \| dsp16xx \
	1186	\| e2k \| elxsi \| epiphany \
	1187	\| f30[01] \| f700 \| fido \| fr30 \| frv \| ft32 \| fx80 \
	1188	\| h8300 \| h8500 \
	1189	\| hppa \| hppa1.[01] \| hppa2.0 \| hppa2.0[nw] \| hppa64 \
	1190	\| hexagon \
	1191	\| i370 \| i*86 \| i860 \| i960 \| ia16 \| ia64 \
	1192	\| ip2k \| iq2000 \
	1193	\| k1om \
	1194	\| le32 \| le64 \
	1195	\| lm32 \
	1196	\| loongarch32 \| loongarch64 \| loongarchx32 \
	1197	\| m32c \| m32r \| m32rle \
	1198	\| m5200 \| m68000 \| m680[012346]0 \| m68360 \| m683?2 \| m68k \
	1199	\| m6811 \| m68hc11 \| m6812 \| m68hc12 \| m68hcs12x \
	1200	\| m88110 \| m88k \| maxq \| mb \| mcore \| mep \| metag \
	1201	\| microblaze \| microblazeel \
	1202	\| mips \| mipsbe \| mipseb \| mipsel \| mipsle \
	1203	\| mips16 \
	1204	\| mips64 \| mips64eb \| mips64el \
	1205	\| mips64octeon \| mips64octeonel \
	1206	\| mips64orion \| mips64orionel \
	1207	\| mips64r5900 \| mips64r5900el \
	1208	\| mips64vr \| mips64vrel \
	1209	\| mips64vr4100 \| mips64vr4100el \
	1210	\| mips64vr4300 \| mips64vr4300el \
	1211	\| mips64vr5000 \| mips64vr5000el \
	1212	\| mips64vr5900 \| mips64vr5900el \
	1213	\| mipsisa32 \| mipsisa32el \
	1214	\| mipsisa32r2 \| mipsisa32r2el \
	1215	\| mipsisa32r3 \| mipsisa32r3el \
	1216	\| mipsisa32r5 \| mipsisa32r5el \
	1217	\| mipsisa32r6 \| mipsisa32r6el \
	1218	\| mipsisa64 \| mipsisa64el \
	1219	\| mipsisa64r2 \| mipsisa64r2el \
	1220	\| mipsisa64r3 \| mipsisa64r3el \
	1221	\| mipsisa64r5 \| mipsisa64r5el \
	1222	\| mipsisa64r6 \| mipsisa64r6el \
	1223	\| mipsisa64sb1 \| mipsisa64sb1el \
	1224	\| mipsisa64sr71k \| mipsisa64sr71kel \
	1225	\| mipsr5900 \| mipsr5900el \
	1226	\| mipstx39 \| mipstx39el \
	1227	\| mmix \
	1228	\| mn10200 \| mn10300 \
	1229	\| moxie \
	1230	\| mt \
	1231	\| msp430 \
	1232	\| nds32 \| nds32le \| nds32be \
	1233	\| nfp \
	1234	\| nios \| nios2 \| nios2eb \| nios2el \
	1235	\| none \| np1 \| ns16k \| ns32k \| nvptx \
	1236	\| open8 \
	1237	\| or1k* \
	1238	\| or32 \
	1239	\| orion \
	1240	\| picochip \
	1241	\| pdp10 \| pdp11 \| pj \| pjl \| pn \| power \
	1242	\| powerpc \| powerpc64 \| powerpc64le \| powerpcle \| powerpcspe \
	1243	\| pru \
	1244	\| pyramid \
	1245	\| riscv \| riscv32 \| riscv32be \| riscv64 \| riscv64be \
	1246	\| rl78 \| romp \| rs6000 \| rx \
	1247	\| s390 \| s390x \
	1248	\| score \
	1249	\| sh \| shl \
	1250	\| sh[1234] \| sh[24]a \| sh[24]ae[lb] \| sh[23]e \| she[lb] \| sh[lb]e \
	1251	\| sh[1234]e[lb] \| sh[12345][lb]e \| sh[23]ele \| sh64 \| sh64le \
	1252	\| sparc \| sparc64 \| sparc64b \| sparc64v \| sparc86x \| sparclet \
	1253	\| sparclite \
	1254	\| sparcv8 \| sparcv9 \| sparcv9b \| sparcv9v \| sv1 \| sx* \
	1255	\| spu \
	1256	\| tahoe \
	1257	\| thumbv7* \
	1258	\| tic30 \| tic4x \| tic54x \| tic55x \| tic6x \| tic80 \
	1259	\| tron \
	1260	\| ubicom32 \
	1261	\| v70 \| v850 \| v850e \| v850e1 \| v850es \| v850e2 \| v850e2v3 \
	1262	\| vax \
	1263	\| visium \
	1264	\| w65 \
	1265	\| wasm32 \| wasm64 \
	1266	\| we32k \
	1267	\| x86 \| x86_64 \| xc16x \| xgate \| xps100 \
	1268	\| xstormy16 \| xtensa* \
	1269	\| ymp \
	1270	\| z8k \| z80)
	1271	;;
	1272
	1273	*)
	1274	echo Invalid configuration \`"$1"\': machine \`"$cpu-$vendor"\' not recognized 1>&2
	1275	exit 1
	1276	;;
785	1277	esac
786	1278	;;
787		isi68 \| isi)
788		basic_machine=m68k-isi
789		os=-sysv
790		;;
791		leon-\|leon[3-9]-)
792		basic_machine=sparc-`echo "$basic_machine" \| sed 's/-.*//'`
793		;;
794		m68knommu)
795		basic_machine=m68k-unknown
796		os=-linux
797		;;
798		m68knommu-*)
799		basic_machine=m68k-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
800		os=-linux
801		;;
802		magnum \| m3230)
803		basic_machine=mips-mips
804		os=-sysv
805		;;
806		merlin)
807		basic_machine=ns32k-utek
808		os=-sysv
809		;;
810		microblaze*)
811		basic_machine=microblaze-xilinx
812		;;
813		mingw64)
814		basic_machine=x86_64-pc
815		os=-mingw64
816		;;
817		mingw32)
818		basic_machine=i686-pc
819		os=-mingw32
820		;;
821		mingw32ce)
822		basic_machine=arm-unknown
823		os=-mingw32ce
824		;;
825		miniframe)
826		basic_machine=m68000-convergent
827		;;
828		mint \| -mint[0-9] \| MiNT \| MiNT[0-9]*)
829		basic_machine=m68k-atari
830		os=-mint
831		;;
832		mips3-)
833		basic_machine=`echo "$basic_machine" \| sed -e 's/mips3/mips64/'`
834		;;
835		mips3*)
836		basic_machine=`echo "$basic_machine" \| sed -e 's/mips3/mips64/'`-unknown
837		;;
838		monitor)
839		basic_machine=m68k-rom68k
840		os=-coff
841		;;
842		morphos)
843		basic_machine=powerpc-unknown
844		os=-morphos
845		;;
846		moxiebox)
847		basic_machine=moxie-unknown
848		os=-moxiebox
849		;;
850		msdos)
851		basic_machine=i386-pc
852		os=-msdos
853		;;
854		ms1-*)
855		basic_machine=`echo "$basic_machine" \| sed -e 's/ms1-/mt-/'`
856		;;
857		msys)
858		basic_machine=i686-pc
859		os=-msys
860		;;
861		mvs)
862		basic_machine=i370-ibm
863		os=-mvs
864		;;
865		nacl)
866		basic_machine=le32-unknown
867		os=-nacl
868		;;
869		ncr3000)
870		basic_machine=i486-ncr
871		os=-sysv4
872		;;
873		netbsd386)
874		basic_machine=i386-unknown
875		os=-netbsd
876		;;
877		netwinder)
878		basic_machine=armv4l-rebel
879		os=-linux
880		;;
881		news \| news700 \| news800 \| news900)
882		basic_machine=m68k-sony
883		os=-newsos
884		;;
885		news1000)
886		basic_machine=m68030-sony
887		os=-newsos
888		;;
889		news-3600 \| risc-news)
890		basic_machine=mips-sony
891		os=-newsos
892		;;
893		necv70)
894		basic_machine=v70-nec
895		os=-sysv
896		;;
897		next \| m*-next)
898		basic_machine=m68k-next
899		case $os in
900		-nextstep* )
901		;;
902		-ns2*)
903		os=-nextstep2
904		;;
905		*)
906		os=-nextstep3
907		;;
908		esac
909		;;
910		nh3000)
911		basic_machine=m68k-harris
912		os=-cxux
913		;;
914		nh[45]000)
915		basic_machine=m88k-harris
916		os=-cxux
917		;;
918		nindy960)
919		basic_machine=i960-intel
920		os=-nindy
921		;;
922		mon960)
923		basic_machine=i960-intel
924		os=-mon960
925		;;
926		nonstopux)
927		basic_machine=mips-compaq
928		os=-nonstopux
929		;;
930		np1)
931		basic_machine=np1-gould
932		;;
933		neo-tandem)
934		basic_machine=neo-tandem
935		;;
936		nse-tandem)
937		basic_machine=nse-tandem
938		;;
939		nsr-tandem)
940		basic_machine=nsr-tandem
941		;;
942		nsv-tandem)
943		basic_machine=nsv-tandem
944		;;
945		nsx-tandem)
946		basic_machine=nsx-tandem
947		;;
948		op50n-* \| op60c-*)
949		basic_machine=hppa1.1-oki
950		os=-proelf
951		;;
952		openrisc \| openrisc-*)
953		basic_machine=or32-unknown
954		;;
955		os400)
956		basic_machine=powerpc-ibm
957		os=-os400
958		;;
959		OSE68000 \| ose68000)
960		basic_machine=m68000-ericsson
961		os=-ose
962		;;
963		os68k)
964		basic_machine=m68k-none
965		os=-os68k
966		;;
967		pa-hitachi)
968		basic_machine=hppa1.1-hitachi
969		os=-hiuxwe2
970		;;
971		paragon)
972		basic_machine=i860-intel
973		os=-osf
974		;;
975		parisc)
976		basic_machine=hppa-unknown
977		os=-linux
978		;;
979		parisc-*)
980		basic_machine=hppa-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
981		os=-linux
982		;;
983		pbd)
984		basic_machine=sparc-tti
985		;;
986		pbb)
987		basic_machine=m68k-tti
988		;;
989		pc532 \| pc532-*)
990		basic_machine=ns32k-pc532
991		;;
992		pc98)
993		basic_machine=i386-pc
994		;;
995		pc98-*)
996		basic_machine=i386-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
997		;;
998		pentium \| p5 \| k5 \| k6 \| nexgen \| viac3)
999		basic_machine=i586-pc
1000		;;
1001		pentiumpro \| p6 \| 6x86 \| athlon \| athlon_*)
1002		basic_machine=i686-pc
1003		;;
1004		pentiumii \| pentium2 \| pentiumiii \| pentium3)
1005		basic_machine=i686-pc
1006		;;
1007		pentium4)
1008		basic_machine=i786-pc
1009		;;
1010		pentium-* \| p5-* \| k5-* \| k6-* \| nexgen-* \| viac3-*)
1011		basic_machine=i586-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
1012		;;
1013		pentiumpro-* \| p6-* \| 6x86-* \| athlon-*)
1014		basic_machine=i686-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
1015		;;
1016		pentiumii-* \| pentium2-* \| pentiumiii-* \| pentium3-*)
1017		basic_machine=i686-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
1018		;;
1019		pentium4-*)
1020		basic_machine=i786-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
1021		;;
1022		pn)
1023		basic_machine=pn-gould
1024		;;
1025		power) basic_machine=power-ibm
1026		;;
1027		ppc \| ppcbe) basic_machine=powerpc-unknown
1028		;;
1029		ppc-* \| ppcbe-*)
1030		basic_machine=powerpc-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
1031		;;
1032		ppcle \| powerpclittle)
1033		basic_machine=powerpcle-unknown
1034		;;
1035		ppcle-* \| powerpclittle-*)
1036		basic_machine=powerpcle-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
1037		;;
1038		ppc64) basic_machine=powerpc64-unknown
1039		;;
1040		ppc64-) basic_machine=powerpc64-`echo "$basic_machine" \| sed 's/^[^-]-//'`
1041		;;
1042		ppc64le \| powerpc64little)
1043		basic_machine=powerpc64le-unknown
1044		;;
1045		ppc64le-* \| powerpc64little-*)
1046		basic_machine=powerpc64le-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
1047		;;
1048		ps2)
1049		basic_machine=i386-ibm
1050		;;
1051		pw32)
1052		basic_machine=i586-unknown
1053		os=-pw32
1054		;;
1055		rdos \| rdos64)
1056		basic_machine=x86_64-pc
1057		os=-rdos
1058		;;
1059		rdos32)
1060		basic_machine=i386-pc
1061		os=-rdos
1062		;;
1063		rom68k)
1064		basic_machine=m68k-rom68k
1065		os=-coff
1066		;;
1067		rm[46]00)
1068		basic_machine=mips-siemens
1069		;;
1070		rtpc \| rtpc-*)
1071		basic_machine=romp-ibm
1072		;;
1073		s390 \| s390-*)
1074		basic_machine=s390-ibm
1075		;;
1076		s390x \| s390x-*)
1077		basic_machine=s390x-ibm
1078		;;
1079		sa29200)
1080		basic_machine=a29k-amd
1081		os=-udi
1082		;;
1083		sb1)
1084		basic_machine=mipsisa64sb1-unknown
1085		;;
1086		sb1el)
1087		basic_machine=mipsisa64sb1el-unknown
1088		;;
1089		sde)
1090		basic_machine=mipsisa32-sde
1091		os=-elf
1092		;;
1093		sei)
1094		basic_machine=mips-sei
1095		os=-seiux
1096		;;
1097		sequent)
1098		basic_machine=i386-sequent
1099		;;
1100		sh5el)
1101		basic_machine=sh5le-unknown
1102		;;
1103		simso-wrs)
1104		basic_machine=sparclite-wrs
1105		os=-vxworks
1106		;;
1107		sps7)
1108		basic_machine=m68k-bull
1109		os=-sysv2
1110		;;
1111		spur)
1112		basic_machine=spur-unknown
1113		;;
1114		st2000)
1115		basic_machine=m68k-tandem
1116		;;
1117		stratus)
1118		basic_machine=i860-stratus
1119		os=-sysv4
1120		;;
1121		strongarm-* \| thumb-*)
1122		basic_machine=arm-`echo "$basic_machine" \| sed 's/^[^-]*-//'`
1123		;;
1124		sun2)
1125		basic_machine=m68000-sun
1126		;;
1127		sun2os3)
1128		basic_machine=m68000-sun
1129		os=-sunos3
1130		;;
1131		sun2os4)
1132		basic_machine=m68000-sun
1133		os=-sunos4
1134		;;
1135		sun3os3)
1136		basic_machine=m68k-sun
1137		os=-sunos3
1138		;;
1139		sun3os4)
1140		basic_machine=m68k-sun
1141		os=-sunos4
1142		;;
1143		sun4os3)
1144		basic_machine=sparc-sun
1145		os=-sunos3
1146		;;
1147		sun4os4)
1148		basic_machine=sparc-sun
1149		os=-sunos4
1150		;;
1151		sun4sol2)
1152		basic_machine=sparc-sun
1153		os=-solaris2
1154		;;
1155		sun3 \| sun3-*)
1156		basic_machine=m68k-sun
1157		;;
1158		sun4)
1159		basic_machine=sparc-sun
1160		;;
1161		sun386 \| sun386i \| roadrunner)
1162		basic_machine=i386-sun
1163		;;
1164		sv1)
1165		basic_machine=sv1-cray
1166		os=-unicos
1167		;;
1168		symmetry)
1169		basic_machine=i386-sequent
1170		os=-dynix
1171		;;
1172		t3e)
1173		basic_machine=alphaev5-cray
1174		os=-unicos
1175		;;
1176		t90)
1177		basic_machine=t90-cray
1178		os=-unicos
1179		;;
1180		tile*)
1181		basic_machine=$basic_machine-unknown
1182		os=-linux-gnu
1183		;;
1184		tx39)
1185		basic_machine=mipstx39-unknown
1186		;;
1187		tx39el)
1188		basic_machine=mipstx39el-unknown
1189		;;
1190		toad1)
1191		basic_machine=pdp10-xkl
1192		os=-tops20
1193		;;
1194		tower \| tower-32)
1195		basic_machine=m68k-ncr
1196		;;
1197		tpf)
1198		basic_machine=s390x-ibm
1199		os=-tpf
1200		;;
1201		udi29k)
1202		basic_machine=a29k-amd
1203		os=-udi
1204		;;
1205		ultra3)
1206		basic_machine=a29k-nyu
1207		os=-sym1
1208		;;
1209		v810 \| necv810)
1210		basic_machine=v810-nec
1211		os=-none
1212		;;
1213		vaxv)
1214		basic_machine=vax-dec
1215		os=-sysv
1216		;;
1217		vms)
1218		basic_machine=vax-dec
1219		os=-vms
1220		;;
1221		vpp\|vx\|vx-)
1222		basic_machine=f301-fujitsu
1223		;;
1224		vxworks960)
1225		basic_machine=i960-wrs
1226		os=-vxworks
1227		;;
1228		vxworks68)
1229		basic_machine=m68k-wrs
1230		os=-vxworks
1231		;;
1232		vxworks29k)
1233		basic_machine=a29k-wrs
1234		os=-vxworks
1235		;;
1236		w65*)
1237		basic_machine=w65-wdc
1238		os=-none
1239		;;
1240		w89k-*)
1241		basic_machine=hppa1.1-winbond
1242		os=-proelf
1243		;;
1244		x64)
1245		basic_machine=x86_64-pc
1246		;;
1247		xbox)
1248		basic_machine=i686-pc
1249		os=-mingw32
1250		;;
1251		xps \| xps100)
1252		basic_machine=xps100-honeywell
1253		;;
1254		xscale-* \| xscalee[bl]-*)
1255		basic_machine=`echo "$basic_machine" \| sed 's/^xscale/arm/'`
1256		;;
1257		ymp)
1258		basic_machine=ymp-cray
1259		os=-unicos
1260		;;
1261		none)
1262		basic_machine=none-none
1263		os=-none
1264		;;
1265
1266		# Here we handle the default manufacturer of certain CPU types. It is in
1267		# some cases the only manufacturer, in others, it is the most popular.
1268		w89k)
1269		basic_machine=hppa1.1-winbond
1270		;;
1271		op50n)
1272		basic_machine=hppa1.1-oki
1273		;;
1274		op60c)
1275		basic_machine=hppa1.1-oki
1276		;;
1277		romp)
1278		basic_machine=romp-ibm
1279		;;
1280		mmix)
1281		basic_machine=mmix-knuth
1282		;;
1283		rs6000)
1284		basic_machine=rs6000-ibm
1285		;;
1286		vax)
1287		basic_machine=vax-dec
1288		;;
1289		pdp11)
1290		basic_machine=pdp11-dec
1291		;;
1292		we32k)
1293		basic_machine=we32k-att
1294		;;
1295		sh[1234] \| sh[24]a \| sh[24]aeb \| sh[34]eb \| sh[1234]le \| sh[23]ele)
1296		basic_machine=sh-unknown
1297		;;
1298		cydra)
1299		basic_machine=cydra-cydrome
1300		;;
1301		orion)
1302		basic_machine=orion-highlevel
1303		;;
1304		orion105)
1305		basic_machine=clipper-highlevel
1306		;;
1307		mac \| mpw \| mac-mpw)
1308		basic_machine=m68k-apple
1309		;;
1310		pmac \| pmac-mpw)
1311		basic_machine=powerpc-apple
1312		;;
1313		*-unknown)
1314		# Make sure to match an already-canonicalized machine name.
	1279	esac
	1280
	1281	# Here we canonicalize certain aliases for manufacturers.
	1282	case $vendor in
	1283	digital*)
	1284	vendor=dec
	1285	;;
	1286	commodore*)
	1287	vendor=cbm
1315	1288	;;
1316	1289	*)
1317		echo Invalid configuration \`"$1"\': machine \`"$basic_machine"\' not recognized 1>&2
1318		exit 1
1319	1290	;;
1320	1291	esac
1321	1292
1322		# Here we canonicalize certain aliases for manufacturers.
1323		case $basic_machine in
1324		-digital)
1325		basic_machine=`echo "$basic_machine" \| sed 's/digital.*/dec/'`
1326		;;
1327		-commodore)
1328		basic_machine=`echo "$basic_machine" \| sed 's/commodore.*/cbm/'`
	1293	# Decode manufacturer-specific aliases for certain operating systems.
	1294
	1295	if test x$basic_os != x
	1296	then
	1297
	1298	# First recognize some ad-hoc caes, or perhaps split kernel-os, or else just
	1299	# set os.
	1300	case $basic_os in
	1301	gnu/linux*)
	1302	kernel=linux
	1303	os=`echo "$basic_os" \| sed -e 's\|gnu/linux\|gnu\|'`
	1304	;;
	1305	os2-emx)
	1306	kernel=os2
	1307	os=`echo "$basic_os" \| sed -e 's\|os2-emx\|emx\|'`
	1308	;;
	1309	nto-qnx*)
	1310	kernel=nto
	1311	os=`echo "$basic_os" \| sed -e 's\|nto-qnx\|qnx\|'`
	1312	;;
	1313	-)
	1314	# shellcheck disable=SC2162
	1315	IFS="-" read kernel os <<EOF
	1316	$basic_os
	1317	EOF
	1318	;;
	1319	# Default OS when just kernel was specified
	1320	nto*)
	1321	kernel=nto
	1322	os=`echo "$basic_os" \| sed -e 's\|nto\|qnx\|'`
	1323	;;
	1324	linux*)
	1325	kernel=linux
	1326	os=`echo "$basic_os" \| sed -e 's\|linux\|gnu\|'`
1329	1327	;;
1330	1328	*)
	1329	kernel=
	1330	os=$basic_os
1331	1331	;;
1332	1332	esac
1333	1333
1334		# Decode manufacturer-specific aliases for certain operating systems.
1335
1336		if [ x"$os" != x"" ]
1337		then
	1334	# Now, normalize the OS (knowing we just have one component, it's not a kernel,
	1335	# etc.)
1338	1336	case $os in
1339	1337	# First match some system type aliases that might get confused
1340	1338	# with valid system types.
1341		# -solaris* is a basic system type, with this one exception.
1342		-auroraux)
1343		os=-auroraux
1344		;;
1345		-solaris1 \| -solaris1.*)
1346		os=`echo $os \| sed -e 's\|solaris1\|sunos4\|'`
1347		;;
1348		-solaris)
1349		os=-solaris2
1350		;;
1351		-unixware*)
1352		os=-sysv4.2uw
1353		;;
1354		-gnu/linux*)
1355		os=`echo $os \| sed -e 's\|gnu/linux\|linux-gnu\|'`
	1339	# solaris* is a basic system type, with this one exception.
	1340	auroraux)
	1341	os=auroraux
	1342	;;
	1343	bluegene*)
	1344	os=cnk
	1345	;;
	1346	solaris1 \| solaris1.*)
	1347	os=`echo "$os" \| sed -e 's\|solaris1\|sunos4\|'`
	1348	;;
	1349	solaris)
	1350	os=solaris2
	1351	;;
	1352	unixware*)
	1353	os=sysv4.2uw
1356	1354	;;
1357	1355	# es1800 is here to avoid being matched by es* (a different OS)
1358		-es1800*)
1359		os=-ose
1360		;;
1361		# Now accept the basic system types.
1362		# The portable systems comes first.
1363		# Each alternative MUST end in a * to match a version number.
1364		# -sysv* is not here because it comes later, after sysvr4.
1365		-gnu* \| -bsd* \| -mach* \| -minix* \| -genix* \| -ultrix* \| -irix* \
1366		\| -vms \| -sco* \| -esix* \| -isc* \| -aix* \| -cnk* \| -sunos \| -sunos[34]*\
1367		\| -hpux* \| -unos* \| -osf* \| -luna* \| -dgux* \| -auroraux* \| -solaris* \
1368		\| -sym* \| -kopensolaris* \| -plan9* \
1369		\| -amigaos* \| -amigados* \| -msdos* \| -newsos* \| -unicos* \| -aof* \
1370		\| -aos* \| -aros* \| -cloudabi* \| -sortix* \
1371		\| -nindy* \| -vxsim* \| -vxworks* \| -ebmon* \| -hms* \| -mvs* \
1372		\| -clix* \| -riscos* \| -uniplus* \| -iris* \| -rtu* \| -xenix* \
1373		\| -hiux* \| -knetbsd* \| -mirbsd* \| -netbsd* \
1374		\| -bitrig* \| -openbsd* \| -solidbsd* \| -libertybsd* \
1375		\| -ekkobsd* \| -kfreebsd* \| -freebsd* \| -riscix* \| -lynxos* \
1376		\| -bosx* \| -nextstep* \| -cxux* \| -aout* \| -elf* \| -oabi* \
1377		\| -ptx* \| -coff* \| -ecoff* \| -winnt* \| -domain* \| -vsta* \
1378		\| -udi* \| -eabi* \| -lites* \| -ieee* \| -go32* \| -aux* \| -hcos* \
1379		\| -chorusos* \| -chorusrdb* \| -cegcc* \| -glidix* \
1380		\| -cygwin* \| -msys* \| -pe* \| -psos* \| -moss* \| -proelf* \| -rtems* \
1381		\| -midipix* \| -mingw32* \| -mingw64* \| -linux-gnu* \| -linux-android* \
1382		\| -linux-newlib* \| -linux-musl* \| -linux-uclibc* \
1383		\| -uxpv* \| -beos* \| -mpeix* \| -udk* \| -moxiebox* \
1384		\| -interix* \| -uwin* \| -mks* \| -rhapsody* \| -darwin* \
1385		\| -openstep* \| -oskit* \| -conix* \| -pw32* \| -nonstopux* \
1386		\| -storm-chaos* \| -tops10* \| -tenex* \| -tops20* \| -its* \
1387		\| -os2* \| -vos* \| -palmos* \| -uclinux* \| -nucleus* \
1388		\| -morphos* \| -superux* \| -rtmk* \| -windiss* \
1389		\| -powermax* \| -dnix* \| -nx6 \| -nx7 \| -sei* \| -dragonfly* \
1390		\| -skyos* \| -haiku* \| -rdos* \| -toppers* \| -drops* \| -es* \
1391		\| -onefs* \| -tirtos* \| -phoenix* \| -fuchsia* \| -redox* \| -bme* \
1392		\| -midnightbsd*)
1393		# Remember, each alternative MUST END IN *, to match a version number.
1394		;;
1395		-qnx*)
1396		case $basic_machine in
1397		x86-* \| i86-)
1398		;;
1399		*)
1400		os=-nto$os
1401		;;
1402		esac
1403		;;
1404		-nto-qnx*)
1405		;;
1406		-nto*)
1407		os=`echo $os \| sed -e 's\|nto\|nto-qnx\|'`
1408		;;
1409		-sim \| -xray \| -os68k* \| -v88r* \
1410		\| -windows* \| -osx \| -abug \| -netware* \| -os9* \
1411		\| -macos* \| -mpw* \| -magic* \| -mmixware* \| -mon960* \| -lnews*)
1412		;;
1413		-mac*)
	1356	es1800*)
	1357	os=ose
	1358	;;
	1359	# Some version numbers need modification
	1360	chorusos*)
	1361	os=chorusos
	1362	;;
	1363	isc)
	1364	os=isc2.2
	1365	;;
	1366	sco6)
	1367	os=sco5v6
	1368	;;
	1369	sco5)
	1370	os=sco3.2v5
	1371	;;
	1372	sco4)
	1373	os=sco3.2v4
	1374	;;
	1375	sco3.2.[4-9]*)
	1376	os=`echo "$os" \| sed -e 's/sco3.2./sco3.2v/'`
	1377	;;
	1378	scov \| scout)
	1379	# Don't match below
	1380	;;
	1381	sco*)
	1382	os=sco3.2v2
	1383	;;
	1384	psos*)
	1385	os=psos
	1386	;;
	1387	qnx*)
	1388	os=qnx
	1389	;;
	1390	hiux*)
	1391	os=hiuxwe2
	1392	;;
	1393	lynx*178)
	1394	os=lynxos178
	1395	;;
	1396	lynx*5)
	1397	os=lynxos5
	1398	;;
	1399	lynxos*)
	1400	# don't get caught up in next wildcard
	1401	;;
	1402	lynx*)
	1403	os=lynxos
	1404	;;
	1405	mac[0-9]*)
1414	1406	os=`echo "$os" \| sed -e 's\|mac\|macos\|'`
1415	1407	;;
1416		-linux-dietlibc)
1417		os=-linux-dietlibc
1418		;;
1419		-linux*)
1420		os=`echo $os \| sed -e 's\|linux\|linux-gnu\|'`
1421		;;
1422		-sunos5*)
	1408	opened*)
	1409	os=openedition
	1410	;;
	1411	os400*)
	1412	os=os400
	1413	;;
	1414	sunos5*)
1423	1415	os=`echo "$os" \| sed -e 's\|sunos5\|solaris2\|'`
1424	1416	;;
1425		-sunos6*)
	1417	sunos6*)
1426	1418	os=`echo "$os" \| sed -e 's\|sunos6\|solaris3\|'`
1427	1419	;;
1428		-opened*)
1429		os=-openedition
1430		;;
1431		-os400*)
1432		os=-os400
1433		;;
1434		-wince*)
1435		os=-wince
1436		;;
1437		-utek*)
1438		os=-bsd
1439		;;
1440		-dynix*)
1441		os=-bsd
1442		;;
1443		-acis*)
1444		os=-aos
1445		;;
1446		-atheos*)
1447		os=-atheos
1448		;;
1449		-syllable*)
1450		os=-syllable
1451		;;
1452		-386bsd)
1453		os=-bsd
1454		;;
1455		-ctix* \| -uts*)
1456		os=-sysv
1457		;;
1458		-nova*)
1459		os=-rtmk-nova
1460		;;
1461		-ns2)
1462		os=-nextstep2
1463		;;
1464		-nsk*)
1465		os=-nsk
	1420	wince*)
	1421	os=wince
	1422	;;
	1423	utek*)
	1424	os=bsd
	1425	;;
	1426	dynix*)
	1427	os=bsd
	1428	;;
	1429	acis*)
	1430	os=aos
	1431	;;
	1432	atheos*)
	1433	os=atheos
	1434	;;
	1435	syllable*)
	1436	os=syllable
	1437	;;
	1438	386bsd)
	1439	os=bsd
	1440	;;
	1441	ctix* \| uts*)
	1442	os=sysv
	1443	;;
	1444	nova*)
	1445	os=rtmk-nova
	1446	;;
	1447	ns2)
	1448	os=nextstep2
1466	1449	;;
1467	1450	# Preserve the version number of sinix5.
1468		-sinix5.*)
1469		os=`echo $os \| sed -e 's\|sinix\|sysv\|'`
1470		;;
1471		-sinix*)
1472		os=-sysv4
1473		;;
1474		-tpf*)
1475		os=-tpf
1476		;;
1477		-triton*)
1478		os=-sysv3
1479		;;
1480		-oss*)
1481		os=-sysv3
1482		;;
1483		-svr4*)
1484		os=-sysv4
1485		;;
1486		-svr3)
1487		os=-sysv3
1488		;;
1489		-sysvr4)
1490		os=-sysv4
1491		;;
1492		# This must come after -sysvr4.
1493		-sysv*)
1494		;;
1495		-ose*)
1496		os=-ose
1497		;;
1498		-mint \| -mint[0-9] \| -MiNT \| -MiNT[0-9])
1499		os=-mint
1500		;;
1501		-zvmoe)
1502		os=-zvmoe
1503		;;
1504		-dicos*)
1505		os=-dicos
1506		;;
1507		-pikeos*)
	1451	sinix5.*)
	1452	os=`echo "$os" \| sed -e 's\|sinix\|sysv\|'`
	1453	;;
	1454	sinix*)
	1455	os=sysv4
	1456	;;
	1457	tpf*)
	1458	os=tpf
	1459	;;
	1460	triton*)
	1461	os=sysv3
	1462	;;
	1463	oss*)
	1464	os=sysv3
	1465	;;
	1466	svr4*)
	1467	os=sysv4
	1468	;;
	1469	svr3)
	1470	os=sysv3
	1471	;;
	1472	sysvr4)
	1473	os=sysv4
	1474	;;
	1475	ose*)
	1476	os=ose
	1477	;;
	1478	mint \| mint[0-9] \| MiNT \| MiNT[0-9])
	1479	os=mint
	1480	;;
	1481	dicos*)
	1482	os=dicos
	1483	;;
	1484	pikeos*)
1508	1485	# Until real need of OS specific support for
1509	1486	# particular features comes up, bare metal
1510	1487	# configurations are quite functional.
1511		case $basic_machine in
	1488	case $cpu in
1512	1489	arm*)
1513		os=-eabi
	1490	os=eabi
1514	1491	;;
1515	1492	*)
1516		os=-elf
	1493	os=elf
1517	1494	;;
1518	1495	esac
1519	1496	;;
1520		-nacl*)
1521		;;
1522		-ios)
1523		;;
1524		-none)
1525		;;
1526	1497	*)
1527		# Get rid of the `-' at the beginning of $os.
1528		os=`echo $os \| sed 's/[^-]*-//'`
1529		echo Invalid configuration \`"$1"\': system \`"$os"\' not recognized 1>&2
1530		exit 1
	1498	# No normalization, but not necessarily accepted, that comes below.
1531	1499	;;
1532	1500	esac
	1501
1533	1502	else
1534	1503
1535	1504	# Here we handle the default operating systems that come with various machines.

1542	1511	# will signal an error saying that MANUFACTURER isn't an operating
1543	1512	# system, and we'll never get to this point.
1544	1513
1545		case $basic_machine in
	1514	kernel=
	1515	case $cpu-$vendor in
1546	1516	score-*)
1547		os=-elf
	1517	os=elf
1548	1518	;;
1549	1519	spu-*)
1550		os=-elf
	1520	os=elf
1551	1521	;;
1552	1522	*-acorn)
1553		os=-riscix1.2
	1523	os=riscix1.2
1554	1524	;;
1555	1525	arm*-rebel)
1556		os=-linux
	1526	kernel=linux
	1527	os=gnu
1557	1528	;;
1558	1529	arm*-semi)
1559		os=-aout
	1530	os=aout
1560	1531	;;
1561	1532	c4x-* \| tic4x-*)
1562		os=-coff
	1533	os=coff
1563	1534	;;
1564	1535	c8051-*)
1565		os=-elf
	1536	os=elf
	1537	;;
	1538	clipper-intergraph)
	1539	os=clix
1566	1540	;;
1567	1541	hexagon-*)
1568		os=-elf
	1542	os=elf
1569	1543	;;
1570	1544	tic54x-*)
1571		os=-coff
	1545	os=coff
1572	1546	;;
1573	1547	tic55x-*)
1574		os=-coff
	1548	os=coff
1575	1549	;;
1576	1550	tic6x-*)
1577		os=-coff
	1551	os=coff
1578	1552	;;
1579	1553	# This must come before the *-dec entry.
1580	1554	pdp10-*)
1581		os=-tops20
	1555	os=tops20
1582	1556	;;
1583	1557	pdp11-*)
1584		os=-none
	1558	os=none
1585	1559	;;
1586	1560	-dec \| vax-)
1587		os=-ultrix4.2
	1561	os=ultrix4.2
1588	1562	;;
1589	1563	m68*-apollo)
1590		os=-domain
	1564	os=domain
1591	1565	;;
1592	1566	i386-sun)
1593		os=-sunos4.0.2
	1567	os=sunos4.0.2
1594	1568	;;
1595	1569	m68000-sun)
1596		os=-sunos3
	1570	os=sunos3
1597	1571	;;
1598	1572	m68*-cisco)
1599		os=-aout
	1573	os=aout
1600	1574	;;
1601	1575	mep-*)
1602		os=-elf
	1576	os=elf
1603	1577	;;
1604	1578	mips*-cisco)
1605		os=-elf
	1579	os=elf
1606	1580	;;
1607	1581	mips-)
1608		os=-elf
	1582	os=elf
1609	1583	;;
1610	1584	or32-*)
1611		os=-coff
	1585	os=coff
1612	1586	;;
1613	1587	*-tti) # must be before sparc entry or we get the wrong os.
1614		os=-sysv3
	1588	os=sysv3
1615	1589	;;
1616	1590	sparc-* \| *-sun)
1617		os=-sunos4.1.1
	1591	os=sunos4.1.1
1618	1592	;;
1619	1593	pru-*)
1620		os=-elf
	1594	os=elf
1621	1595	;;
1622	1596	*-be)
1623		os=-beos
	1597	os=beos
1624	1598	;;
1625	1599	*-ibm)
1626		os=-aix
	1600	os=aix
1627	1601	;;
1628	1602	*-knuth)
1629		os=-mmixware
	1603	os=mmixware
1630	1604	;;
1631	1605	*-wec)
1632		os=-proelf
	1606	os=proelf
1633	1607	;;
1634	1608	*-winbond)
1635		os=-proelf
	1609	os=proelf
1636	1610	;;
1637	1611	*-oki)
1638		os=-proelf
	1612	os=proelf
1639	1613	;;
1640	1614	*-hp)
1641		os=-hpux
	1615	os=hpux
1642	1616	;;
1643	1617	*-hitachi)
1644		os=-hiux
	1618	os=hiux
1645	1619	;;
1646	1620	i860-* \| -att \| -ncr \| -altos \| -motorola \| *-convergent)
1647		os=-sysv
	1621	os=sysv
1648	1622	;;
1649	1623	*-cbm)
1650		os=-amigaos
	1624	os=amigaos
1651	1625	;;
1652	1626	*-dg)
1653		os=-dgux
	1627	os=dgux
1654	1628	;;
1655	1629	*-dolphin)
1656		os=-sysv3
	1630	os=sysv3
1657	1631	;;
1658	1632	m68k-ccur)
1659		os=-rtu
	1633	os=rtu
1660	1634	;;
1661	1635	m88k-omron*)
1662		os=-luna
	1636	os=luna
1663	1637	;;
1664	1638	*-next)
1665		os=-nextstep
	1639	os=nextstep
1666	1640	;;
1667	1641	*-sequent)
1668		os=-ptx
	1642	os=ptx
1669	1643	;;
1670	1644	*-crds)
1671		os=-unos
	1645	os=unos
1672	1646	;;
1673	1647	*-ns)
1674		os=-genix
	1648	os=genix
1675	1649	;;
1676	1650	i370-*)
1677		os=-mvs
	1651	os=mvs
1678	1652	;;
1679	1653	*-gould)
1680		os=-sysv
	1654	os=sysv
1681	1655	;;
1682	1656	*-highlevel)
1683		os=-bsd
	1657	os=bsd
1684	1658	;;
1685	1659	*-encore)
1686		os=-bsd
	1660	os=bsd
1687	1661	;;
1688	1662	*-sgi)
1689		os=-irix
	1663	os=irix
1690	1664	;;
1691	1665	*-siemens)
1692		os=-sysv4
	1666	os=sysv4
1693	1667	;;
1694	1668	*-masscomp)
1695		os=-rtu
	1669	os=rtu
1696	1670	;;
1697	1671	f30[01]-fujitsu \| f700-fujitsu)
1698		os=-uxpv
	1672	os=uxpv
1699	1673	;;
1700	1674	*-rom68k)
1701		os=-coff
	1675	os=coff
1702	1676	;;
1703	1677	-bug)
1704		os=-coff
	1678	os=coff
1705	1679	;;
1706	1680	*-apple)
1707		os=-macos
	1681	os=macos
1708	1682	;;
1709	1683	-atari)
1710		os=-mint
	1684	os=mint
	1685	;;
	1686	*-wrs)
	1687	os=vxworks
1711	1688	;;
1712	1689	*)
1713		os=-none
	1690	os=none
1714	1691	;;
1715	1692	esac
	1693
1716	1694	fi
	1695
	1696	# Now, validate our (potentially fixed-up) OS.
	1697	case $os in
	1698	# Sometimes we do "kernel-libc", so those need to count as OSes.
	1699	musl* \| newlib* \| uclibc*)
	1700	;;
	1701	# Likewise for "kernel-abi"
	1702	eabi* \| gnueabi*)
	1703	;;
	1704	# VxWorks passes extra cpu info in the 4th filed.
	1705	simlinux \| simwindows \| spe)
	1706	;;
	1707	# Now accept the basic system types.
	1708	# The portable systems comes first.
	1709	# Each alternative MUST end in a * to match a version number.
	1710	gnu* \| android* \| bsd* \| mach* \| minix* \| genix* \| ultrix* \| irix* \
	1711	\| vms \| esix* \| aix* \| cnk* \| sunos \| sunos[34]* \
	1712	\| hpux* \| unos* \| osf* \| luna* \| dgux* \| auroraux* \| solaris* \
	1713	\| sym* \| plan9* \| psp* \| sim* \| xray* \| os68k* \| v88r* \
	1714	\| hiux* \| abug \| nacl* \| netware* \| windows* \
	1715	\| os9* \| macos* \| osx* \| ios* \
	1716	\| mpw* \| magic* \| mmixware* \| mon960* \| lnews* \
	1717	\| amigaos* \| amigados* \| msdos* \| newsos* \| unicos* \| aof* \
	1718	\| aos* \| aros* \| cloudabi* \| sortix* \| twizzler* \
	1719	\| nindy* \| vxsim* \| vxworks* \| ebmon* \| hms* \| mvs* \
	1720	\| clix* \| riscos* \| uniplus* \| iris* \| isc* \| rtu* \| xenix* \
	1721	\| mirbsd* \| netbsd* \| dicos* \| openedition* \| ose* \
	1722	\| bitrig* \| openbsd* \| secbsd* \| solidbsd* \| libertybsd* \| os108* \
	1723	\| ekkobsd* \| freebsd* \| riscix* \| lynxos* \| os400* \
	1724	\| bosx* \| nextstep* \| cxux* \| aout* \| elf* \| oabi* \
	1725	\| ptx* \| coff* \| ecoff* \| winnt* \| domain* \| vsta* \
	1726	\| udi* \| lites* \| ieee* \| go32* \| aux* \| hcos* \
	1727	\| chorusrdb* \| cegcc* \| glidix* \| serenity* \
	1728	\| cygwin* \| msys* \| pe* \| moss* \| proelf* \| rtems* \
	1729	\| midipix* \| mingw32* \| mingw64* \| mint* \
	1730	\| uxpv* \| beos* \| mpeix* \| udk* \| moxiebox* \
	1731	\| interix* \| uwin* \| mks* \| rhapsody* \| darwin* \
	1732	\| openstep* \| oskit* \| conix* \| pw32* \| nonstopux* \
	1733	\| storm-chaos* \| tops10* \| tenex* \| tops20* \| its* \
	1734	\| os2* \| vos* \| palmos* \| uclinux* \| nucleus* \| morphos* \
	1735	\| scout* \| superux* \| sysv* \| rtmk* \| tpf* \| windiss* \
	1736	\| powermax* \| dnix* \| nx6 \| nx7 \| sei* \| dragonfly* \
	1737	\| skyos* \| haiku* \| rdos* \| toppers* \| drops* \| es* \
	1738	\| onefs* \| tirtos* \| phoenix* \| fuchsia* \| redox* \| bme* \
	1739	\| midnightbsd* \| amdhsa* \| unleashed* \| emscripten* \| wasi* \
	1740	\| nsk* \| powerunix* \| genode* \| zvmoe* \| qnx* \| emx*)
	1741	;;
	1742	# This one is extra strict with allowed versions
	1743	sco3.2v2 \| sco3.2v[4-9]* \| sco5v6*)
	1744	# Don't forget version if it is 3.2v4 or newer.
	1745	;;
	1746	none)
	1747	;;
	1748	*)
	1749	echo Invalid configuration \`"$1"\': OS \`"$os"\' not recognized 1>&2
	1750	exit 1
	1751	;;
	1752	esac
	1753
	1754	# As a final step for OS-related things, validate the OS-kernel combination
	1755	# (given a valid OS), if there is a kernel.
	1756	case $kernel-$os in
	1757	linux-gnu* \| linux-dietlibc* \| linux-android* \| linux-newlib* \| linux-musl* \| linux-uclibc* )
	1758	;;
	1759	uclinux-uclibc* )
	1760	;;
	1761	-dietlibc* \| -newlib* \| -musl* \| -uclibc* )
	1762	# These are just libc implementations, not actual OSes, and thus
	1763	# require a kernel.
	1764	echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2
	1765	exit 1
	1766	;;
	1767	kfreebsd-gnu \| kopensolaris-gnu)
	1768	;;
	1769	vxworks-simlinux \| vxworks-simwindows \| vxworks-spe)
	1770	;;
	1771	nto-qnx*)
	1772	;;
	1773	os2-emx)
	1774	;;
	1775	-eabi \| -gnueabi)
	1776	;;
	1777	-*)
	1778	# Blank kernel with real OS is always fine.
	1779	;;
	1780	-)
	1781	echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2
	1782	exit 1
	1783	;;
	1784	esac
1717	1785
1718	1786	# Here we handle the case where we know the os, and the CPU type, but not the
1719	1787	# manufacturer. We pick the logical manufacturer.
1720		vendor=unknown
1721		case $basic_machine in
1722		*-unknown)
1723		case $os in
1724		-riscix*)
	1788	case $vendor in
	1789	unknown)
	1790	case $cpu-$os in
	1791	-riscix)
1725	1792	vendor=acorn
1726	1793	;;
1727		-sunos*)
	1794	-sunos)
1728	1795	vendor=sun
1729	1796	;;
1730		-cnk\|-aix)
	1797	-cnk \| -aix)
1731	1798	vendor=ibm
1732	1799	;;
1733		-beos*)
	1800	-beos)
1734	1801	vendor=be
1735	1802	;;
1736		-hpux*)
	1803	-hpux)
1737	1804	vendor=hp
1738	1805	;;
1739		-mpeix*)
	1806	-mpeix)
1740	1807	vendor=hp
1741	1808	;;
1742		-hiux*)
	1809	-hiux)
1743	1810	vendor=hitachi
1744	1811	;;
1745		-unos*)
	1812	-unos)
1746	1813	vendor=crds
1747	1814	;;
1748		-dgux*)
	1815	-dgux)
1749	1816	vendor=dg
1750	1817	;;
1751		-luna*)
	1818	-luna)
1752	1819	vendor=omron
1753	1820	;;
1754		-genix*)
	1821	-genix)
1755	1822	vendor=ns
1756	1823	;;
1757		-mvs* \| -opened*)
	1824	-clix)
	1825	vendor=intergraph
	1826	;;
	1827	-mvs \| -opened)
1758	1828	vendor=ibm
1759	1829	;;
1760		-os400*)
	1830	-os400)
1761	1831	vendor=ibm
1762	1832	;;
1763		-ptx*)
	1833	s390-* \| s390x-*)
	1834	vendor=ibm
	1835	;;
	1836	-ptx)
1764	1837	vendor=sequent
1765	1838	;;
1766		-tpf*)
	1839	-tpf)
1767	1840	vendor=ibm
1768	1841	;;
1769		-vxsim* \| -vxworks* \| -windiss*)
	1842	-vxsim \| -vxworks \| -windiss)
1770	1843	vendor=wrs
1771	1844	;;
1772		-aux*)
	1845	-aux)
1773	1846	vendor=apple
1774	1847	;;
1775		-hms*)
	1848	-hms)
1776	1849	vendor=hitachi
1777	1850	;;
1778		-mpw* \| -macos*)
	1851	-mpw \| -macos)
1779	1852	vendor=apple
1780	1853	;;
1781		-mint \| -mint[0-9] \| -MiNT \| -MiNT[0-9])
	1854	-mint \| -mint[0-9] \| -MiNT \| -MiNT[0-9])
1782	1855	vendor=atari
1783	1856	;;
1784		-vos*)
	1857	-vos)
1785	1858	vendor=stratus
1786	1859	;;
1787	1860	esac
1788		basic_machine=`echo "$basic_machine" \| sed "s/unknown/$vendor/"`
1789	1861	;;
1790	1862	esac
1791	1863
1792		echo "$basic_machine$os"
	1864	echo "$cpu-$vendor-${kernel:+$kernel-}$os"
1793	1865	exit
1794	1866
1795	1867	# Local variables:

-8

autosetup/autosetup-find-tclsh less more

0	0	#!/bin/sh
1	1	# Looks for a suitable tclsh or jimsh in the PATH
2		# If not found, builds a bootstrap jimsh from source
3		# Prefer $autosetup_tclsh if is set in the environment
4		d=`dirname "$0"`
5		{ "$d/jimsh0" "$d/autosetup-test-tclsh"; } 2>/dev/null && exit 0
6		PATH="$PATH:$d"; export PATH
7		for tclsh in $autosetup_tclsh jimsh tclsh tclsh8.5 tclsh8.6; do
	2	# If not found, builds a bootstrap jimsh in current dir from source
	3	# Prefer $autosetup_tclsh if is set in the environment (unless ./jimsh0 works)
	4	d="`dirname "$0"`"
	5	for tclsh in ./jimsh0 $autosetup_tclsh jimsh tclsh tclsh8.5 tclsh8.6 tclsh8.7; do
8	6	{ $tclsh "$d/autosetup-test-tclsh"; } 2>/dev/null && exit 0
9	7	done
10	8	echo 1>&2 "No installed jimsh or tclsh, building local bootstrap jimsh0"
11	9	for cc in ${CC_FOR_BUILD:-cc} gcc; do
12		{ $cc -o "$d/jimsh0" "$d/jimsh0.c"; } 2>/dev/null \|\| continue
13		"$d/jimsh0" "$d/autosetup-test-tclsh" && exit 0
	10	{ $cc -o jimsh0 "$d/jimsh0.c"; } 2>/dev/null \|\| continue
	11	./jimsh0 "$d/autosetup-test-tclsh" && exit 0
14	12	done
15	13	echo 1>&2 "No working C compiler found. Tried ${CC_FOR_BUILD:-cc} and gcc."
16	14	echo false

-1

autosetup/cc-db.tcl less more

7	7
8	8	use cc
9	9
10		module-options {}
	10	options {}
11	11
12	12	# openbsd needs sys/types.h to detect some system headers
13	13	cc-include-needs sys/socket.h sys/types.h

-2

autosetup/cc-lib.tcl less more

5	5	# Provides a library of common tests on top of the 'cc' module.
6	6
7	7	use cc
8
9		module-options {}
10	8
11	9	# @cc-check-lfs
12	10	#

-1

autosetup/cc-shared.tcl less more

19	19	## LD_LIBRARY_PATH Environment variable which specifies path to shared libraries
20	20	## STRIPLIBFLAGS Arguments to strip a dynamic library
21	21
22		module-options {}
	22	options {}
23	23
24	24	# Defaults: gcc on unix
25	25	define SHOBJ_CFLAGS -fPIC

-3

autosetup/cc.tcl less more

28	28
29	29	use system
30	30
31		module-options {}
	31	options {}
32	32
33	33	# Checks for the existence of the given function by linking
34	34	#

679	679	define CPP [get-env CPP "[get-define CC] -E"]
680	680
681	681	# XXX: Could avoid looking for a C++ compiler until requested
682		# Note that if CXX isn't found, we just set it to "false". It might not be needed.
	682	# If CXX isn't found, it is set to the empty string.
683	683	if {[env-is-set CXX]} {
684	684	define CXX [find-an-executable -required [get-env CXX ""]]
685	685	} else {
686		define CXX [find-an-executable [get-define cross]c++ [get-define cross]g++ false]
	686	define CXX [find-an-executable [get-define cross]c++ [get-define cross]g++]
687	687	}
688	688
689	689	# CXXFLAGS default to CFLAGS if not specified

+60

-18

autosetup/local.tcl less more

58	58	set use_pkgconfig 0
59	59	set pkgconfig [ext-get $ext pkg-config]
60	60	if {$pkgconfig ne ""} {
61		# pkg-config support is optional, so explicitly initialse it here
	61	# pkg-config support is optional, so explicitly initialise it here
62	62	if {[pkg-config-init 0]} {
63		lassign $pkgconfig pkg args
64
65		if {[pkg-config {*}$pkgconfig]} {
66		# Found via pkg-config so ignore check and libdep
67		set use_pkgconfig 1
	63	# Check for at least one set of alternates
	64	foreach pinfo [split $pkgconfig \|] {
	65	set ok 1
	66	set pkgs {}
	67	foreach pkg [split $pinfo ,] {
	68	set args [lassign $pkg pkgname]
	69	set pkg [string trim $pkg]
	70	set optional 0
	71	if {[string match {[]} $pkg]} {
	72	# This package is optional
	73	set optional 1
	74	set pkg [string range $pkg 0 end-1]
	75	}
	76	if {![pkg-config $pkg {*}$args]} {
	77	if {!$optional} {
	78	set ok 0
	79	break
	80	}
	81	} else {
	82	lappend pkgs $pkg
	83	}
	84	}
	85	if {$ok} {
	86	set use_pkgconfig 1
	87	break
	88	}
68	89	}
69	90	}
70	91	}

123	144	} else {
124	145	msg-result "Extension $ext...module"
125	146	if {$use_pkgconfig} {
126		define-append LDLIBS_$ext [pkg-config-get $pkg LIBS]
127		define-append LDFLAGS [pkg-config-get $pkg LDFLAGS]
128		define-append CCOPTS [pkg-config-get $pkg CFLAGS]
129		define-append PKG_CONFIG_REQUIRES $pkg
	147	add-pkgconfig-deps $ext $pkgs $asmodule
130	148	} else {
131	149	foreach i [ext-get $ext libdep] {
132	150	define-append LDLIBS_$ext [get-define $i ""]

148	166	return [ext-set-status $ext x]
149	167	}
150	168	if {$use_pkgconfig} {
151		define-append LDLIBS [pkg-config-get $pkg LIBS]
	169	add-pkgconfig-deps $ext $pkgs $asmodule
	170	} else {
	171	foreach i [ext-get $ext libdep] {
	172	define-append LDLIBS [get-define $i ""]
	173	}
	174	}
	175	return [ext-set-status $ext y]
	176	}
	177
	178	# Add dependencies for a pkg-config module to the extension
	179	proc add-pkgconfig-deps {ext pkgs asmodule} {
	180	foreach pkg $pkgs {
	181	if {$asmodule} {
	182	define-append LDLIBS_$ext [pkg-config-get $pkg LIBS]
	183	} else {
	184	define-append LDLIBS [pkg-config-get $pkg LIBS]
	185	}
152	186	define-append LDFLAGS [pkg-config-get $pkg LDFLAGS]
153	187	define-append CCOPTS [pkg-config-get $pkg CFLAGS]
154	188	define-append PKG_CONFIG_REQUIRES $pkg
155		} else {
156		foreach i [ext-get $ext libdep] {
157		define-append LDLIBS [get-define $i ""]
158		}
159		}
160		return [ext-set-status $ext y]
	189	}
161	190	}
162	191
163	192	# Examines the user options (the $withinfo array)
164	193	# and the extension database ($extdb) to determine
165	194	# what is selected, and in what way.
	195	#
	196	# If $allextmod is 1, extensions that would normally be disabled
	197	# are enabled as modules if their prerequisites are met
166	198	#
167	199	# The results are available via ext-get-status
168	200	# And a dictionary is returned containing four keys:

170	202	# static-tcl extensions which are static Tcl
171	203	# module-c extensions which are C modules
172	204	# module-tcl extensions which are Tcl modules
173		proc check-extensions {} {
	205	proc check-extensions {allextmod} {
174	206	global extdb withinfo
175	207
176	208	# Check valid extension names

183	215	set extlist [lsort [dict keys [dict get $extdb attrs]]]
184	216
185	217	set withinfo(maybe) {}
	218	set withinfo(maybemod) {}
186	219
187	220	# Now work out the default status. We have.
188	221	# normal case, include !off, !optional if possible

193	226	} else {
194	227	foreach i $extlist {
195	228	if {[ext-has $i off]} {
	229	if {$allextmod} {
	230	lappend withinfo(maybemod) $i
	231	}
196	232	continue
197	233	}
198	234	if {[ext-has $i optional] && !$withinfo(optional)} {
	235	if {$allextmod} {
	236	lappend withinfo(maybemod) $i
	237	}
199	238	continue
200	239	}
201	240	lappend withinfo(maybe) $i

211	250	}
212	251	foreach i $withinfo(maybe) {
213	252	check-extension-status $i wanted
	253	}
	254	foreach i $withinfo(maybemod) {
	255	check-extension-status $i wanted 1
214	256	}
215	257
216	258	array set extinfo {static-c {} static-tcl {} module-c {} module-tcl {}}

+40

-7

autosetup/pkg-config.tcl less more

14	14
15	15	use cc
16	16
17		module-options {
	17	options {
18	18	sysroot:dir => "Override compiler sysroot for pkg-config search path"
19	19	}
20	20

52	52	define SYSROOT [file-normalize $o]
53	53	msg-result "Using specified sysroot [get-define SYSROOT]"
54	54	} elseif {[get-define build] ne [get-define host]} {
55		if {[catch {exec-with-stderr [get-define CC] -print-sysroot} result errinfo] == 0} {
	55	if {[catch {exec-with-stderr {*}[get-define CC] -print-sysroot} result errinfo] == 0} {
56	56	# Use the compiler sysroot, if there is one
57	57	define SYSROOT $result
58	58	msg-result "Found compiler sysroot $result"
59	59	} else {
	60	configlog "[get-define CC] -print-sysroot: $result"
60	61	set msg "pkg-config: Cross compiling, but no compiler sysroot and no --sysroot supplied"
61	62	if {$required} {
62	63	user-error $msg

72	73	# XXX: It's possible that these should be set only when invoking pkg-config
73	74	global env
74	75	set env(PKG_CONFIG_DIR) ""
	76	# Supposedly setting PKG_CONFIG_LIBDIR means that PKG_CONFIG_PATH is ignored,
	77	# but it doesn't seem to work that way in practice
	78	set env(PKG_CONFIG_PATH) ""
75	79	# Do we need to try /usr/local as well or instead?
76	80	set env(PKG_CONFIG_LIBDIR) $sysroot/usr/lib/pkgconfig:$sysroot/usr/share/pkgconfig
77	81	set env(PKG_CONFIG_SYSROOT_DIR) $sysroot

107	111	return 0
108	112	}
109	113
110		if {[catch {exec [get-define PKG_CONFIG] --modversion "$module $args"} version]} {
	114	set pkgconfig [get-define PKG_CONFIG]
	115
	116	set ret [catch {exec $pkgconfig --modversion "$module $args"} version]
	117	configlog "$pkgconfig --modversion $module $args: $version"
	118	if {$ret} {
111	119	msg-result "not found"
112		configlog "pkg-config --modversion $module $args: $version"
	120	return 0
	121	}
	122	# Sometimes --modversion succeeds but because of dependencies it isn't usable
	123	# This seems to show up with --cflags
	124	set ret [catch {exec $pkgconfig --cflags $module} cflags]
	125	if {$ret} {
	126	msg-result "unusable ($version - see config.log)"
	127	configlog "$pkgconfig --cflags $module"
	128	configlog $cflags
113	129	return 0
114	130	}
115	131	msg-result $version
116	132	set prefix [feature-define-name $module PKG_]
117	133	define HAVE_${prefix}
118	134	define ${prefix}_VERSION $version
119		define ${prefix}_LIBS [exec pkg-config --libs-only-l $module]
120		define ${prefix}_LDFLAGS [exec pkg-config --libs-only-L $module]
121		define ${prefix}_CFLAGS [exec pkg-config --cflags $module]
	135	define ${prefix}_CFLAGS $cflags
	136	define ${prefix}_LIBS [exec $pkgconfig --libs-only-l $module]
	137	define ${prefix}_LDFLAGS [exec $pkgconfig --libs-only-L $module]
122	138	return 1
123	139	}
124	140

132	148	set prefix [feature-define-name $module PKG_]
133	149	get-define ${prefix}_${name} ""
134	150	}
	151
	152	# @pkg-config-get-var module variable
	153	#
	154	# Return the value of the given variable from the given pkg-config module.
	155	# The module must already have been successfully detected with pkg-config.
	156	# e.g.
	157	#
	158	## if {[pkg-config harfbuzz >= 2.5]} {
	159	## define harfbuzz_libdir [pkg-config-get-var harfbuzz libdir]
	160	## }
	161	#
	162	# Returns the empty string if the variable isn't defined.
	163	proc pkg-config-get-var {module variable} {
	164	set pkgconfig [get-define PKG_CONFIG]
	165	set prefix [feature-define-name $module HAVE_PKG_]
	166	exec $pkgconfig $module --variable $variable
	167	}

-2

autosetup/system.tcl less more

26	26	options-defaults [list prefix [get-define defaultprefix]]
27	27	}
28	28
29		module-options [subst -noc -nob {
	29	options {
30	30	host:host-alias => {a complete or partial cpu-vendor-opsys for the system where
31	31	the application will run (defaults to the same value as --build)}
32	32	build:build-alias => {a complete or partial cpu-vendor-opsys for the system

51	51	maintainer-mode=0
52	52	dependency-tracking=0
53	53	silent-rules=0
54		}]
	54	}
55	55
56	56	# @check-feature name { script }
57	57	#

-1

autosetup/tmake.tcl less more

10	10
11	11	use system
12	12
13		module-options {}
	13	options {}
14	14
15	15	define CONFIGURED
16	16

-4

bootstrap.tcl less more

0	0	# Minimal support for package require
1		# No error on failure since C extensions aren't handled
2		proc package {cmd pkg args} {
	1	proc package {cmd args} {
3	2	if {$cmd eq "require"} {
4	3	foreach path $::auto_path {
	4	lassign $args pkg
5	5	set pkgpath $path/$pkg.tcl
6	6	if {$path eq "."} {
7	7	set pkgpath $pkg.tcl
8	8	}
9	9	if {[file exists $pkgpath]} {
10		uplevel #0 [list source $pkgpath]
11		return
	10	tailcall uplevel #0 [list source $pkgpath]
12	11	}
13	12	}
14	13	}
15	14	}
	15	set tcl_platform(bootstrap) 1

-0

configure.ac less more

0	0	# Dummy configure.ac to make automake happy
	1	AC_INIT([jimtcl], [0.80])
	2	AC_OUTPUT

+11

-0

debian/changelog less more

	0	jimtcl (0.81+dfsg0-1) experimental; urgency=medium
	1
	2	* Update to new upstream version 0.81
	3	- Bump libjim SONAME from 0.79 to 0.81
	4	- Rebase pacthes; drop upstream backports
	5	- Add debian/watch file
	6
	7	* Add myself as maintainer (Closes: #993599).
	8
	9	-- Bo YU <tsu.yubo@gmail.com> Tue, 22 Mar 2022 10:15:19 +0800
	10
0	11	jimtcl (0.79+dfsg0-3) unstable; urgency=medium
1	12
2	13	* Orphan package

-4

debian/control less more

0	0	Source: jimtcl
1		Maintainer: Debian QA Group <packages@qa.debian.org>
	1	Maintainer: Bo YU <tsu.yubo@gmail.com>
2	2	Section: devel
3	3	Priority: optional
4	4	Build-Depends:

6	6	debhelper-compat (= 13),
7	7	Standards-Version: 4.6.0
8	8	Vcs-Browser: https://salsa.debian.org/debian/jimtcl
9		Vcs-Git: https://salsa.debian.org/debian/jimtcl.git
	9	Vcs-Git: https://salsa.debian.org/vimerbf-guest/jimtcl.git
10	10	Homepage: http://jim.tcl.tk/
11	11
12	12	Package: jimsh

30	30	Multi-Arch: same
31	31	Section: libdevel
32	32	Depends:
33		libjim0.79 (= ${binary:Version}),
	33	libjim0.81 (= ${binary:Version}),
34	34	${misc:Depends},
35	35	Description: small-footprint implementation of Tcl - development files
36	36	Jim is an opensource small-footprint implementation of the Tcl programming

42	42	.
43	43	This package provides the libjim development files.
44	44
45		Package: libjim0.79
	45	Package: libjim0.81
46	46	Architecture: any
47	47	Multi-Arch: same
48	48	Section: libs

-2

debian/copyright less more

15	15	2009 David Brownell
16	16	License: BSD-2-clause
17	17
18		Files: autosetup/
	18	Files: autosetup/*
19	19	Copyright: 2006-2011, WorkWare Systems
20	20	License: BSD-2-clause
21	21

70	70	permission to use and distribute the software in accordance with the
71	71	terms specified in this license.
72	72
73		Files: debian/
	73	Files: debian/*
74	74	Copyright: 2011 Edgar Grimberg <edgar.grimberg@gmail.com>
75	75	2011 Steve Bennett <steveb@workware.net.au>
76	76	2011-2014 Didier Raboud <odyx@debian.org>

-1

~~debian/libjim0.79.install~~ less more

usr/lib/*/libjim.so.*

-226

~~debian/libjim0.79.symbols~~ less more

0		libjim.so.0.79 libjim0.79 #MINVER#
1		JimCanonicalNamespace@Base 0.73
2		JimStringReplaceObj@Base 0.73
3		Jim_AddHashEntry@Base 0.72
4		Jim_AioFile@Base 0.77
5		Jim_AioFilehandle@Base 0.72
6		Jim_Alloc@Base 0.72
7		Jim_AppendObj@Base 0.72
8		Jim_AppendString@Base 0.72
9		Jim_AppendStrings@Base 0.72
10		Jim_CallSubCmd@Base 0.72
11		Jim_CheckShowCommands@Base 0.79
12		Jim_Collect@Base 0.72
13		Jim_CollectIfNeeded@Base 0.72
14		Jim_CommandMatchObj@Base 0.72
15		Jim_CompareStringImmediate@Base 0.72
16		Jim_ConcatObj@Base 0.72
17		Jim_CreateCommand@Base 0.72
18		Jim_CreateFileHandler@Base 0.72
19		Jim_CreateInterp@Base 0.72
20		Jim_CreateNamespaceVariable@Base 0.73
21		Jim_CreateTimeHandler@Base 0.72
22		Jim_DeleteAssocData@Base 0.72
23		Jim_DeleteCommand@Base 0.72
24		Jim_DeleteFileHandler@Base 0.72
25		Jim_DeleteHashEntry@Base 0.72
26		Jim_DeleteTimeHandler@Base 0.72
27		Jim_DictAddElement@Base 0.72
28		Jim_DictInfo@Base 0.75
29		Jim_DictKey@Base 0.72
30		Jim_DictKeysVector@Base 0.72
31		Jim_DictMatchTypes@Base 0.79
32		Jim_DictMerge@Base 0.79
33		Jim_DictPairs@Base 0.72
34		Jim_DictSize@Base 0.72
35		Jim_DuplicateObj@Base 0.72
36		Jim_Eval@Base 0.72
37		Jim_EvalExpression@Base 0.72
38		Jim_EvalFile@Base 0.72
39		Jim_EvalFileGlobal@Base 0.72
40		Jim_EvalGlobal@Base 0.72
41		Jim_EvalNamespace@Base 0.73
42		Jim_EvalObj@Base 0.72
43		Jim_EvalObjBackground@Base 0.72
44		Jim_EvalObjList@Base 0.73
45		Jim_EvalObjPrefix@Base 0.72
46		Jim_EvalObjVector@Base 0.72
47		Jim_EvalSource@Base 0.72
48		Jim_ExpandHashTable@Base 0.72
49		Jim_FindByName@Base 0.72
50		Jim_FindHashEntry@Base 0.72
51		Jim_FormatString@Base 0.72
52		Jim_Free@Base 0.72
53		Jim_FreeHashTable@Base 0.72
54		Jim_FreeInterp@Base 0.72
55		Jim_FreeObj@Base 0.72
56		Jim_FreeStack@Base 0.72
57		Jim_FreeStackElements@Base 0.72
58		Jim_GenHashFunction@Base 0.72
59		Jim_GetAssocData@Base 0.72
60		Jim_GetBoolean@Base 0.77
61		Jim_GetBoolFromExpr@Base 0.72
62		Jim_GetCallFrameByLevel@Base 0.72
63		Jim_GetCommand@Base 0.72
64		Jim_GetDouble@Base 0.72
65		Jim_GetEnum@Base 0.72
66		Jim_GetEnviron@Base 0.72
67		Jim_GetExitCode@Base 0.72
68		Jim_GetFinalizer@Base 0.72
69		Jim_GetGlobalVariable@Base 0.72
70		Jim_GetGlobalVariableStr@Base 0.72
71		Jim_GetHashTableIterator@Base 0.72
72		Jim_GetIndex@Base 0.72
73		Jim_GetLong@Base 0.72
74		Jim_GetReference@Base 0.72
75		Jim_GetReturnCode@Base 0.72
76		Jim_GetString@Base 0.72
77		Jim_GetTtySettings@Base 0.79
78		Jim_GetVariable@Base 0.72
79		Jim_GetVariableStr@Base 0.72
80		Jim_GetWide@Base 0.72
81		Jim_HistoryAdd@Base 0.73
82		Jim_HistoryGetline@Base 0.73
83		Jim_HistoryLoad@Base 0.73
84		Jim_HistorySave@Base 0.73
85		Jim_HistorySetCompletion@Base 0.79
86		Jim_HistoryShow@Base 0.73
87		Jim_InitHashTable@Base 0.72
88		Jim_InitStack@Base 0.72
89		Jim_InitStaticExtensions@Base 0.72
90		Jim_IntHashFunction@Base 0.72
91		Jim_InteractivePrompt@Base 0.72
92		Jim_InvalidateStringRep@Base 0.72
93		Jim_IsBigEndian@Base 0.75
94		Jim_IsDict@Base 0.72
95		Jim_IsList@Base 0.72
96		Jim_Length@Base 0.72
97		Jim_ListAppendElement@Base 0.72
98		Jim_ListAppendList@Base 0.72
99		Jim_ListGetIndex@Base 0.73
100		Jim_ListIndex@Base 0.72
101		Jim_ListInsertElements@Base 0.72
102		Jim_ListJoin@Base 0.73
103		Jim_ListLength@Base 0.72
104		Jim_ListRange@Base 0.72
105		Jim_ListSetIndex@Base 0.75
106		Jim_LoadLibrary@Base 0.72
107		Jim_MakeErrorMessage@Base 0.72
108		Jim_MakeGlobalNamespaceName@Base 0.75
109		Jim_MakeTempFile@Base 0.75-1~
110		Jim_NamespaceQualifiers@Base 0.73
111		Jim_NamespaceTail@Base 0.73
112		Jim_NewDictObj@Base 0.72
113		Jim_NewDoubleObj@Base 0.72
114		Jim_NewIntObj@Base 0.72
115		Jim_NewListObj@Base 0.72
116		Jim_NewObj@Base 0.72
117		Jim_NewReference@Base 0.72
118		Jim_NewStringObj@Base 0.72
119		Jim_NewStringObjNoAlloc@Base 0.72
120		Jim_NewStringObjUtf8@Base 0.72
121		Jim_NextHashEntry@Base 0.72
122		Jim_OpenForRead@Base 0.79
123		Jim_OpenForWrite@Base 0.79
124		Jim_PackageProvide@Base 0.72
125		Jim_PackageRequire@Base 0.72
126		Jim_ParseSubCmd@Base 0.72
127		Jim_ProcessEvents@Base 0.72
128		Jim_ReaddirCmd@Base 0.72
129		Jim_Realloc@Base 0.72
130		Jim_RegexpCmd@Base 0.72
131		Jim_RegisterCoreCommands@Base 0.72
132		Jim_RegsubCmd@Base 0.72
133		Jim_RenameCommand@Base 0.72
134		Jim_ReplaceHashEntry@Base 0.72
135		Jim_ReturnCode@Base 0.72
136		Jim_ScanString@Base 0.72
137		Jim_ScriptIsComplete@Base 0.72
138		Jim_SetAssocData@Base 0.72
139		Jim_SetDictKeysVector@Base 0.72
140		Jim_SetEnviron@Base 0.72
141		Jim_SetFinalizer@Base 0.72
142		Jim_SetGlobalVariableStr@Base 0.72
143		Jim_SetResultErrno@Base 0.79
144		Jim_SetResultFormatted@Base 0.72
145		Jim_SetTtySettings@Base 0.79
146		Jim_SetVariable@Base 0.72
147		Jim_SetVariableLink@Base 0.72
148		Jim_SetVariableStr@Base 0.72
149		Jim_SetVariableStrWithStr@Base 0.72
150		Jim_SignalId@Base 0.72
151		Jim_StackLen@Base 0.72
152		Jim_StackPeek@Base 0.72
153		Jim_StackPop@Base 0.72
154		Jim_StackPush@Base 0.72
155		Jim_StrDup@Base 0.72
156		Jim_StrDupLen@Base 0.72
157		Jim_String@Base 0.73
158		Jim_StringByteRangeObj@Base 0.72
159		Jim_StringCompareLenObj@Base 0.73
160		Jim_StringCompareObj@Base 0.72
161		Jim_StringEqObj@Base 0.72
162		Jim_StringMatchObj@Base 0.72
163		Jim_StringRangeObj@Base 0.72
164		Jim_StringToDouble@Base 0.72
165		Jim_StringToWide@Base 0.72
166		Jim_SubCmdProc@Base 0.72
167		Jim_SubstObj@Base 0.72
168		Jim_SyslogCmd@Base 0.72
169		Jim_UnsetVariable@Base 0.72
170		Jim_Utf8Length@Base 0.72
171		Jim_WrongNumArgs@Base 0.72
172		Jim_aioInit@Base 0.72
173		Jim_arrayInit@Base 0.72
174		Jim_clockInit@Base 0.72
175		Jim_eventloopInit@Base 0.72
176		Jim_execInit@Base 0.72
177		Jim_fileInit@Base 0.72
178		Jim_globInit@Base 0.72
179		Jim_historyInit@Base 0.73
180		Jim_interpInit@Base 0.77
181		Jim_loadInit@Base 0.72
182		Jim_namespaceInit@Base 0.73
183		Jim_nshelperInit@Base 0.73
184		Jim_ooInit@Base 0.73
185		Jim_packInit@Base 0.73
186		Jim_packageInit@Base 0.72
187		Jim_posixInit@Base 0.72
188		Jim_readdirInit@Base 0.72
189		Jim_regexpInit@Base 0.72
190		Jim_signalInit@Base 0.72
191		Jim_stdlibInit@Base 0.72
192		Jim_syslogInit@Base 0.72
193		Jim_tclcompatInit@Base 0.72
194		Jim_treeInit@Base 0.73
195		jim_tt_name@Base 0.72
196		linenoise@Base 0.72
197		linenoiseAddCompletion@Base 0.79
198		linenoiseClearScreen@Base 0.79
199		linenoiseColumns@Base 0.74
200		linenoiseHistory@Base 0.72
201		linenoiseHistoryAdd@Base 0.72
202		linenoiseHistoryAddAllocated@Base 0.79
203		linenoiseHistoryFree@Base 0.72
204		linenoiseHistoryGetMaxLen@Base 0.74
205		linenoiseHistoryLoad@Base 0.72
206		linenoiseHistorySave@Base 0.72
207		linenoiseHistorySetMaxLen@Base 0.72
208		linenoiseSetCompletionCallback@Base 0.79
209		linenoiseSetFreeHintsCallback@Base 0.79
210		linenoiseSetHintsCallback@Base 0.79
211		linenoiseSetMultiLine@Base 0.79
212		regcomp@Base 0.73
213		regerror@Base 0.73
214		regexec@Base 0.73
215		regfree@Base 0.73
216		sb_alloc@Base 0.79
217		sb_append@Base 0.79
218		sb_append_len@Base 0.79
219		sb_clear@Base 0.79
220		sb_delete@Base 0.79
221		sb_free@Base 0.79
222		sb_insert@Base 0.79
223		sb_realloc@Base 0.79
224		sb_to_string@Base 0.79
225		utf8_fromunicode@Base 0.72

-0

debian/libjim0.81.install less more

usr/lib/*/libjim.so.*

+234

-0

debian/libjim0.81.symbols less more

	0	libjim.so.0.81 libjim0.81 #MINVER#
	1	JimCanonicalNamespace@Base 0.73
	2	JimStringReplaceObj@Base 0.73
	3	Jim_AddHashEntry@Base 0.72
	4	Jim_AioFile@Base 0.77
	5	Jim_AioFilehandle@Base 0.72
	6	Jim_Alloc@Base 0.72
	7	Jim_AppendObj@Base 0.72
	8	Jim_AppendString@Base 0.72
	9	Jim_AppendStrings@Base 0.72
	10	Jim_CallSubCmd@Base 0.72
	11	Jim_CheckAbiVersion@Base 0.81
	12	Jim_CheckShowCommands@Base 0.79
	13	Jim_ClearHashTable@Base 0.81
	14	Jim_Collect@Base 0.72
	15	Jim_CollectIfNeeded@Base 0.72
	16	Jim_CommandMatchObj@Base 0.72
	17	Jim_CompareStringImmediate@Base 0.72
	18	Jim_ConcatObj@Base 0.72
	19	Jim_CreateCommand@Base 0.72
	20	Jim_CreateCommandObj@Base 0.81
	21	Jim_CreateFileHandler@Base 0.72
	22	Jim_CreateInterp@Base 0.72
	23	Jim_CreateNamespaceVariable@Base 0.73
	24	Jim_CreateScriptFileHandler@Base 0.81
	25	Jim_CreateTimeHandler@Base 0.72
	26	Jim_DeleteAssocData@Base 0.72
	27	Jim_DeleteCommand@Base 0.72
	28	Jim_DeleteFileHandler@Base 0.72
	29	Jim_DeleteHashEntry@Base 0.72
	30	Jim_DeleteTimeHandler@Base 0.72
	31	Jim_DictAddElement@Base 0.72
	32	Jim_DictInfo@Base 0.75
	33	Jim_DictKey@Base 0.72
	34	Jim_DictKeysVector@Base 0.72
	35	Jim_DictMatchTypes@Base 0.79
	36	Jim_DictMerge@Base 0.79
	37	Jim_DictPairs@Base 0.72
	38	Jim_DictSize@Base 0.72
	39	Jim_DuplicateObj@Base 0.72
	40	Jim_Eval@Base 0.72
	41	Jim_EvalExpression@Base 0.72
	42	Jim_EvalFile@Base 0.72
	43	Jim_EvalFileGlobal@Base 0.72
	44	Jim_EvalGlobal@Base 0.72
	45	Jim_EvalNamespace@Base 0.73
	46	Jim_EvalObj@Base 0.72
	47	Jim_EvalObjBackground@Base 0.72
	48	Jim_EvalObjList@Base 0.73
	49	Jim_EvalObjPrefix@Base 0.72
	50	Jim_EvalObjVector@Base 0.72
	51	Jim_EvalSource@Base 0.72
	52	Jim_ExpandHashTable@Base 0.72
	53	Jim_FindByName@Base 0.72
	54	Jim_FindFileHandler@Base 0.81
	55	Jim_FindHashEntry@Base 0.72
	56	Jim_FormatString@Base 0.72
	57	Jim_Free@Base 0.72
	58	Jim_FreeHashTable@Base 0.72
	59	Jim_FreeInterp@Base 0.72
	60	Jim_FreeObj@Base 0.72
	61	Jim_FreeStack@Base 0.72
	62	Jim_FreeStackElements@Base 0.72
	63	Jim_GenHashFunction@Base 0.72
	64	Jim_GetAssocData@Base 0.72
	65	Jim_GetBoolean@Base 0.77
	66	Jim_GetBoolFromExpr@Base 0.72
	67	Jim_GetCallFrameByLevel@Base 0.72
	68	Jim_GetCommand@Base 0.72
	69	Jim_GetDouble@Base 0.72
	70	Jim_GetEnum@Base 0.72
	71	Jim_GetEnviron@Base 0.72
	72	Jim_GetExitCode@Base 0.72
	73	Jim_GetFinalizer@Base 0.72
	74	Jim_GetGlobalVariable@Base 0.72
	75	Jim_GetGlobalVariableStr@Base 0.72
	76	Jim_GetHashTableIterator@Base 0.72
	77	Jim_GetIndex@Base 0.72
	78	Jim_GetLong@Base 0.72
	79	Jim_GetReference@Base 0.72
	80	Jim_GetReturnCode@Base 0.72
	81	Jim_GetString@Base 0.72
	82	Jim_GetTtySettings@Base 0.79
	83	Jim_GetVariable@Base 0.72
	84	Jim_GetVariableStr@Base 0.72
	85	Jim_GetWide@Base 0.72
	86	Jim_GetWideExpr@Base 0.81
	87	Jim_HistoryAdd@Base 0.73
	88	Jim_HistoryGetline@Base 0.73
	89	Jim_HistoryGetMaxLen@Base 0.81
	90	Jim_HistoryLoad@Base 0.73
	91	Jim_HistorySave@Base 0.73
	92	Jim_HistorySetCompletion@Base 0.79
	93	Jim_HistorySetMaxLen@Base 0.81
	94	Jim_HistoryShow@Base 0.73
	95	Jim_InitHashTable@Base 0.72
	96	Jim_InitStack@Base 0.72
	97	Jim_InitStaticExtensions@Base 0.72
	98	Jim_IntHashFunction@Base 0.72
	99	Jim_InteractivePrompt@Base 0.72
	100	Jim_InterpIncrProcEpoch@Base 0.81
	101	Jim_InvalidateStringRep@Base 0.72
	102	Jim_IsBigEndian@Base 0.75
	103	Jim_IsDict@Base 0.72
	104	Jim_IsList@Base 0.72
	105	Jim_Length@Base 0.72
	106	Jim_ListAppendElement@Base 0.72
	107	Jim_ListAppendList@Base 0.72
	108	Jim_ListGetIndex@Base 0.73
	109	Jim_ListIndex@Base 0.72
	110	Jim_ListInsertElements@Base 0.72
	111	Jim_ListJoin@Base 0.73
	112	Jim_ListLength@Base 0.72
	113	Jim_ListRange@Base 0.72
	114	Jim_ListSetIndex@Base 0.75
	115	Jim_LoadLibrary@Base 0.72
	116	Jim_MakeErrorMessage@Base 0.72
	117	Jim_MakeGlobalNamespaceName@Base 0.75
	118	Jim_MakeTempFile@Base 0.75-1~
	119	Jim_NamespaceQualifiers@Base 0.73
	120	Jim_NamespaceTail@Base 0.73
	121	Jim_NewDictObj@Base 0.72
	122	Jim_NewDoubleObj@Base 0.72
	123	Jim_NewIntObj@Base 0.72
	124	Jim_NewListObj@Base 0.72
	125	Jim_NewObj@Base 0.72
	126	Jim_NewReference@Base 0.72
	127	Jim_NewStringObj@Base 0.72
	128	Jim_NewStringObjNoAlloc@Base 0.72
	129	Jim_NewStringObjUtf8@Base 0.72
	130	Jim_NextHashEntry@Base 0.72
	131	Jim_OpenForRead@Base 0.79
	132	Jim_OpenForWrite@Base 0.79
	133	Jim_PackageProvide@Base 0.72
	134	Jim_PackageRequire@Base 0.72
	135	Jim_ParseSubCmd@Base 0.72
	136	Jim_ProcessEvents@Base 0.72
	137	Jim_ReaddirCmd@Base 0.72
	138	Jim_Realloc@Base 0.72
	139	Jim_RegexpCmd@Base 0.72
	140	Jim_RegisterCoreCommands@Base 0.72
	141	Jim_RegsubCmd@Base 0.72
	142	Jim_RenameCommand@Base 0.72
	143	Jim_ReplaceHashEntry@Base 0.72
	144	Jim_ReturnCode@Base 0.72
	145	Jim_ScanString@Base 0.72
	146	Jim_ScriptIsComplete@Base 0.72
	147	Jim_SetAssocData@Base 0.72
	148	Jim_SetDictKeysVector@Base 0.72
	149	Jim_SetEnviron@Base 0.72
	150	Jim_SetFinalizer@Base 0.72
	151	Jim_SetGlobalVariableStr@Base 0.72
	152	Jim_SetResultErrno@Base 0.79
	153	Jim_SetResultFormatted@Base 0.72
	154	Jim_SetTtySettings@Base 0.79
	155	Jim_SetVariable@Base 0.72
	156	Jim_SetVariableLink@Base 0.72
	157	Jim_SetVariableStr@Base 0.72
	158	Jim_SetVariableStrWithStr@Base 0.72
	159	Jim_SignalId@Base 0.72
	160	Jim_StackLen@Base 0.72
	161	Jim_StackPeek@Base 0.72
	162	Jim_StackPop@Base 0.72
	163	Jim_StackPush@Base 0.72
	164	Jim_StrDup@Base 0.72
	165	Jim_StrDupLen@Base 0.72
	166	Jim_String@Base 0.73
	167	Jim_StringByteRangeObj@Base 0.72
	168	Jim_StringCompareObj@Base 0.72
	169	Jim_StringEqObj@Base 0.72
	170	Jim_StringMatchObj@Base 0.72
	171	Jim_StringRangeObj@Base 0.72
	172	Jim_StringToDouble@Base 0.72
	173	Jim_StringToWide@Base 0.72
	174	Jim_SubCmdProc@Base 0.72
	175	Jim_SubstObj@Base 0.72
	176	Jim_SyslogCmd@Base 0.72
	177	Jim_UnsetVariable@Base 0.72
	178	Jim_Utf8Length@Base 0.72
	179	Jim_WrongNumArgs@Base 0.72
	180	Jim_aioInit@Base 0.72
	181	Jim_arrayInit@Base 0.72
	182	Jim_clockInit@Base 0.72
	183	Jim_eventloopInit@Base 0.72
	184	Jim_execInit@Base 0.72
	185	Jim_fileInit@Base 0.72
	186	Jim_globInit@Base 0.72
	187	Jim_historyInit@Base 0.73
	188	Jim_interpInit@Base 0.77
	189	Jim_loadInit@Base 0.72
	190	Jim_namespaceInit@Base 0.73
	191	Jim_nshelperInit@Base 0.73
	192	Jim_ooInit@Base 0.73
	193	Jim_packInit@Base 0.73
	194	Jim_packageInit@Base 0.72
	195	Jim_posixInit@Base 0.72
	196	Jim_readdirInit@Base 0.72
	197	jim_regcomp@Base 0.81
	198	jim_regerror@Base 0.81
	199	jim_regexec@Base 0.81
	200	Jim_regexpInit@Base 0.72
	201	jim_regfree@Base 0.81
	202	Jim_signalInit@Base 0.72
	203	Jim_stdlibInit@Base 0.72
	204	Jim_syslogInit@Base 0.72
	205	Jim_tclcompatInit@Base 0.72
	206	Jim_treeInit@Base 0.73
	207	jim_tt_name@Base 0.72
	208	linenoise@Base 0.72
	209	linenoiseAddCompletion@Base 0.79
	210	linenoiseClearScreen@Base 0.79
	211	linenoiseColumns@Base 0.74
	212	linenoiseHistory@Base 0.72
	213	linenoiseHistoryAdd@Base 0.72
	214	linenoiseHistoryAddAllocated@Base 0.79
	215	linenoiseHistoryFree@Base 0.72
	216	linenoiseHistoryGetMaxLen@Base 0.74
	217	linenoiseHistoryLoad@Base 0.72
	218	linenoiseHistorySave@Base 0.72
	219	linenoiseHistorySetMaxLen@Base 0.72
	220	linenoiseSetCompletionCallback@Base 0.79
	221	linenoiseSetFreeHintsCallback@Base 0.79
	222	linenoiseSetHintsCallback@Base 0.79
	223	linenoiseSetMultiLine@Base 0.79
	224	sb_alloc@Base 0.79
	225	sb_append@Base 0.79
	226	sb_append_len@Base 0.79
	227	sb_clear@Base 0.79
	228	sb_delete@Base 0.79
	229	sb_free@Base 0.79
	230	sb_insert@Base 0.79
	231	sb_realloc@Base 0.79
	232	sb_to_string@Base 0.79
	233	utf8_fromunicode@Base 0.72

-22

~~debian/patches/0001-Use-footer-style-none-in-asciidoc-call.patch~~ less more

0		From: Didier Raboud <odyx@debian.org>
1		Date: Sun, 27 Aug 2017 17:19:03 +0200
2		Subject: Use footer-style=none in asciidoc call
3
4		In the asciidoc call, use the '-a footer-style=none' to export without the footer; as it contains the build timestamp, which makes the build unreproducible
5		---
6		Makefile.in \| 2 +-
7		1 file changed, 1 insertion(+), 1 deletion(-)
8
9		diff --git a/Makefile.in b/Makefile.in
10		index 67d503c..270d42e 100644
11		--- a/Makefile.in
12		+++ b/Makefile.in
13		@@ -177,7 +177,7 @@ install-docs:
14
15		Tcl.html: jim_tcl.txt @srcdir@/make-index
16		@if HAVE_ASCIIDOC
17		- @tclsh@ @srcdir@/make-index $> $^ \| @ASCIIDOC@ -d manpage - \| @SED@ -e '/^<div.*id="footer-text"/,/<\/div>/d' >$@
18		+ @tclsh@ @srcdir@/make-index $> $^ \| @ASCIIDOC@ -d manpage -a footer-style=none - \| @SED@ -e '/^<div.*id="footer-text"/,/<\/div>/d' >$@
19		@else
20		@echo "asciidoc is not available"; false
21		@endif

-26

~~debian/patches/0002-Disable-RPATH-support-in-Debian-builds.patch~~ less more

0		From: Didier Raboud <odyx@debian.org>
1		Date: Thu, 21 Nov 2019 10:37:32 +0100
2		Subject: Disable RPATH support in Debian builds
3
4		---
5		auto.def \| 7 ++-----
6		1 file changed, 2 insertions(+), 5 deletions(-)
7
8		diff --git a/auto.def b/auto.def
9		index fe6e4a2..3a3216b 100644
10		--- a/auto.def
11		+++ b/auto.def
12		@@ -314,11 +314,8 @@ if {[opt-bool shared with-jim-shared]} {
13		}
14		define VERSION [format %.2f [expr {[get-define JIM_VERSION] / 100.0}]]
15		define LIBSOEXT [format [get-define SH_SOEXTVER] [get-define VERSION]]
16		-if {[get-define libdir] ni {/lib /usr/lib}} {
17		- define SH_LINKRPATH_FLAGS [format [get-define SH_LINKRPATH] [get-define libdir]]
18		-} else {
19		- define SH_LINKRPATH_FLAGS ""
20		-}
21		+# Disable RPATH support in Debian builds
22		+define SH_LINKRPATH_FLAGS ""
23		define JIM_INSTALL [opt-bool install-jim]
24		define JIM_DOCS [opt-bool docs]
25		define JIM_RANDOMISE_HASH [opt-bool random-hash]

-2

~~debian/patches/series~~ less more

0		0001-Use-footer-style-none-in-asciidoc-call.patch
1		0002-Disable-RPATH-support-in-Debian-builds.patch

-0

debian/watch less more

	0
	1	version=4
	2	opts=\
	3	repacksuffix=+ds,\
	4	repack,compression=xz,\
	5	dversionmangle=s/\+(debian\|dfsg\|ds\|deb)(\.?\d+)?$//,\
	6	filenamemangle=s%(?:.?)?v?(\d[\d.])\.tar\.gz%<project>-$1.tar.gz% \
	7	https://github.com/msteveb/jimtcl/tags \
	8	(?:.?/)?v?(\d[\d.])\.tar\.gz debian uupdate

+674

-0

examples/COPYING.FreeSans.ttf less more

	0	GNU GENERAL PUBLIC LICENSE
	1	Version 3, 29 June 2007
	2
	3	Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
	4	Everyone is permitted to copy and distribute verbatim copies
	5	of this license document, but changing it is not allowed.
	6
	7	Preamble
	8
	9	The GNU General Public License is a free, copyleft license for
	10	software and other kinds of works.
	11
	12	The licenses for most software and other practical works are designed
	13	to take away your freedom to share and change the works. By contrast,
	14	the GNU General Public License is intended to guarantee your freedom to
	15	share and change all versions of a program--to make sure it remains free
	16	software for all its users. We, the Free Software Foundation, use the
	17	GNU General Public License for most of our software; it applies also to
	18	any other work released this way by its authors. You can apply it to
	19	your programs, too.
	20
	21	When we speak of free software, we are referring to freedom, not
	22	price. Our General Public Licenses are designed to make sure that you
	23	have the freedom to distribute copies of free software (and charge for
	24	them if you wish), that you receive source code or can get it if you
	25	want it, that you can change the software or use pieces of it in new
	26	free programs, and that you know you can do these things.
	27
	28	To protect your rights, we need to prevent others from denying you
	29	these rights or asking you to surrender the rights. Therefore, you have
	30	certain responsibilities if you distribute copies of the software, or if
	31	you modify it: responsibilities to respect the freedom of others.
	32
	33	For example, if you distribute copies of such a program, whether
	34	gratis or for a fee, you must pass on to the recipients the same
	35	freedoms that you received. You must make sure that they, too, receive
	36	or can get the source code. And you must show them these terms so they
	37	know their rights.
	38
	39	Developers that use the GNU GPL protect your rights with two steps:
	40	(1) assert copyright on the software, and (2) offer you this License
	41	giving you legal permission to copy, distribute and/or modify it.
	42
	43	For the developers' and authors' protection, the GPL clearly explains
	44	that there is no warranty for this free software. For both users' and
	45	authors' sake, the GPL requires that modified versions be marked as
	46	changed, so that their problems will not be attributed erroneously to
	47	authors of previous versions.
	48
	49	Some devices are designed to deny users access to install or run
	50	modified versions of the software inside them, although the manufacturer
	51	can do so. This is fundamentally incompatible with the aim of
	52	protecting users' freedom to change the software. The systematic
	53	pattern of such abuse occurs in the area of products for individuals to
	54	use, which is precisely where it is most unacceptable. Therefore, we
	55	have designed this version of the GPL to prohibit the practice for those
	56	products. If such problems arise substantially in other domains, we
	57	stand ready to extend this provision to those domains in future versions
	58	of the GPL, as needed to protect the freedom of users.
	59
	60	Finally, every program is threatened constantly by software patents.
	61	States should not allow patents to restrict development and use of
	62	software on general-purpose computers, but in those that do, we wish to
	63	avoid the special danger that patents applied to a free program could
	64	make it effectively proprietary. To prevent this, the GPL assures that
	65	patents cannot be used to render the program non-free.
	66
	67	The precise terms and conditions for copying, distribution and
	68	modification follow.
	69
	70	TERMS AND CONDITIONS
	71
	72	0. Definitions.
	73
	74	"This License" refers to version 3 of the GNU General Public License.
	75
	76	"Copyright" also means copyright-like laws that apply to other kinds of
	77	works, such as semiconductor masks.
	78
	79	"The Program" refers to any copyrightable work licensed under this
	80	License. Each licensee is addressed as "you". "Licensees" and
	81	"recipients" may be individuals or organizations.
	82
	83	To "modify" a work means to copy from or adapt all or part of the work
	84	in a fashion requiring copyright permission, other than the making of an
	85	exact copy. The resulting work is called a "modified version" of the
	86	earlier work or a work "based on" the earlier work.
	87
	88	A "covered work" means either the unmodified Program or a work based
	89	on the Program.
	90
	91	To "propagate" a work means to do anything with it that, without
	92	permission, would make you directly or secondarily liable for
	93	infringement under applicable copyright law, except executing it on a
	94	computer or modifying a private copy. Propagation includes copying,
	95	distribution (with or without modification), making available to the
	96	public, and in some countries other activities as well.
	97
	98	To "convey" a work means any kind of propagation that enables other
	99	parties to make or receive copies. Mere interaction with a user through
	100	a computer network, with no transfer of a copy, is not conveying.
	101
	102	An interactive user interface displays "Appropriate Legal Notices"
	103	to the extent that it includes a convenient and prominently visible
	104	feature that (1) displays an appropriate copyright notice, and (2)
	105	tells the user that there is no warranty for the work (except to the
	106	extent that warranties are provided), that licensees may convey the
	107	work under this License, and how to view a copy of this License. If
	108	the interface presents a list of user commands or options, such as a
	109	menu, a prominent item in the list meets this criterion.
	110
	111	1. Source Code.
	112
	113	The "source code" for a work means the preferred form of the work
	114	for making modifications to it. "Object code" means any non-source
	115	form of a work.
	116
	117	A "Standard Interface" means an interface that either is an official
	118	standard defined by a recognized standards body, or, in the case of
	119	interfaces specified for a particular programming language, one that
	120	is widely used among developers working in that language.
	121
	122	The "System Libraries" of an executable work include anything, other
	123	than the work as a whole, that (a) is included in the normal form of
	124	packaging a Major Component, but which is not part of that Major
	125	Component, and (b) serves only to enable use of the work with that
	126	Major Component, or to implement a Standard Interface for which an
	127	implementation is available to the public in source code form. A
	128	"Major Component", in this context, means a major essential component
	129	(kernel, window system, and so on) of the specific operating system
	130	(if any) on which the executable work runs, or a compiler used to
	131	produce the work, or an object code interpreter used to run it.
	132
	133	The "Corresponding Source" for a work in object code form means all
	134	the source code needed to generate, install, and (for an executable
	135	work) run the object code and to modify the work, including scripts to
	136	control those activities. However, it does not include the work's
	137	System Libraries, or general-purpose tools or generally available free
	138	programs which are used unmodified in performing those activities but
	139	which are not part of the work. For example, Corresponding Source
	140	includes interface definition files associated with source files for
	141	the work, and the source code for shared libraries and dynamically
	142	linked subprograms that the work is specifically designed to require,
	143	such as by intimate data communication or control flow between those
	144	subprograms and other parts of the work.
	145
	146	The Corresponding Source need not include anything that users
	147	can regenerate automatically from other parts of the Corresponding
	148	Source.
	149
	150	The Corresponding Source for a work in source code form is that
	151	same work.
	152
	153	2. Basic Permissions.
	154
	155	All rights granted under this License are granted for the term of
	156	copyright on the Program, and are irrevocable provided the stated
	157	conditions are met. This License explicitly affirms your unlimited
	158	permission to run the unmodified Program. The output from running a
	159	covered work is covered by this License only if the output, given its
	160	content, constitutes a covered work. This License acknowledges your
	161	rights of fair use or other equivalent, as provided by copyright law.
	162
	163	You may make, run and propagate covered works that you do not
	164	convey, without conditions so long as your license otherwise remains
	165	in force. You may convey covered works to others for the sole purpose
	166	of having them make modifications exclusively for you, or provide you
	167	with facilities for running those works, provided that you comply with
	168	the terms of this License in conveying all material for which you do
	169	not control copyright. Those thus making or running the covered works
	170	for you must do so exclusively on your behalf, under your direction
	171	and control, on terms that prohibit them from making any copies of
	172	your copyrighted material outside their relationship with you.
	173
	174	Conveying under any other circumstances is permitted solely under
	175	the conditions stated below. Sublicensing is not allowed; section 10
	176	makes it unnecessary.
	177
	178	3. Protecting Users' Legal Rights From Anti-Circumvention Law.
	179
	180	No covered work shall be deemed part of an effective technological
	181	measure under any applicable law fulfilling obligations under article
	182	11 of the WIPO copyright treaty adopted on 20 December 1996, or
	183	similar laws prohibiting or restricting circumvention of such
	184	measures.
	185
	186	When you convey a covered work, you waive any legal power to forbid
	187	circumvention of technological measures to the extent such circumvention
	188	is effected by exercising rights under this License with respect to
	189	the covered work, and you disclaim any intention to limit operation or
	190	modification of the work as a means of enforcing, against the work's
	191	users, your or third parties' legal rights to forbid circumvention of
	192	technological measures.
	193
	194	4. Conveying Verbatim Copies.
	195
	196	You may convey verbatim copies of the Program's source code as you
	197	receive it, in any medium, provided that you conspicuously and
	198	appropriately publish on each copy an appropriate copyright notice;
	199	keep intact all notices stating that this License and any
	200	non-permissive terms added in accord with section 7 apply to the code;
	201	keep intact all notices of the absence of any warranty; and give all
	202	recipients a copy of this License along with the Program.
	203
	204	You may charge any price or no price for each copy that you convey,
	205	and you may offer support or warranty protection for a fee.
	206
	207	5. Conveying Modified Source Versions.
	208
	209	You may convey a work based on the Program, or the modifications to
	210	produce it from the Program, in the form of source code under the
	211	terms of section 4, provided that you also meet all of these conditions:
	212
	213	a) The work must carry prominent notices stating that you modified
	214	it, and giving a relevant date.
	215
	216	b) The work must carry prominent notices stating that it is
	217	released under this License and any conditions added under section
	218	7. This requirement modifies the requirement in section 4 to
	219	"keep intact all notices".
	220
	221	c) You must license the entire work, as a whole, under this
	222	License to anyone who comes into possession of a copy. This
	223	License will therefore apply, along with any applicable section 7
	224	additional terms, to the whole of the work, and all its parts,
	225	regardless of how they are packaged. This License gives no
	226	permission to license the work in any other way, but it does not
	227	invalidate such permission if you have separately received it.
	228
	229	d) If the work has interactive user interfaces, each must display
	230	Appropriate Legal Notices; however, if the Program has interactive
	231	interfaces that do not display Appropriate Legal Notices, your
	232	work need not make them do so.
	233
	234	A compilation of a covered work with other separate and independent
	235	works, which are not by their nature extensions of the covered work,
	236	and which are not combined with it such as to form a larger program,
	237	in or on a volume of a storage or distribution medium, is called an
	238	"aggregate" if the compilation and its resulting copyright are not
	239	used to limit the access or legal rights of the compilation's users
	240	beyond what the individual works permit. Inclusion of a covered work
	241	in an aggregate does not cause this License to apply to the other
	242	parts of the aggregate.
	243
	244	6. Conveying Non-Source Forms.
	245
	246	You may convey a covered work in object code form under the terms
	247	of sections 4 and 5, provided that you also convey the
	248	machine-readable Corresponding Source under the terms of this License,
	249	in one of these ways:
	250
	251	a) Convey the object code in, or embodied in, a physical product
	252	(including a physical distribution medium), accompanied by the
	253	Corresponding Source fixed on a durable physical medium
	254	customarily used for software interchange.
	255
	256	b) Convey the object code in, or embodied in, a physical product
	257	(including a physical distribution medium), accompanied by a
	258	written offer, valid for at least three years and valid for as
	259	long as you offer spare parts or customer support for that product
	260	model, to give anyone who possesses the object code either (1) a
	261	copy of the Corresponding Source for all the software in the
	262	product that is covered by this License, on a durable physical
	263	medium customarily used for software interchange, for a price no
	264	more than your reasonable cost of physically performing this
	265	conveying of source, or (2) access to copy the
	266	Corresponding Source from a network server at no charge.
	267
	268	c) Convey individual copies of the object code with a copy of the
	269	written offer to provide the Corresponding Source. This
	270	alternative is allowed only occasionally and noncommercially, and
	271	only if you received the object code with such an offer, in accord
	272	with subsection 6b.
	273
	274	d) Convey the object code by offering access from a designated
	275	place (gratis or for a charge), and offer equivalent access to the
	276	Corresponding Source in the same way through the same place at no
	277	further charge. You need not require recipients to copy the
	278	Corresponding Source along with the object code. If the place to
	279	copy the object code is a network server, the Corresponding Source
	280	may be on a different server (operated by you or a third party)
	281	that supports equivalent copying facilities, provided you maintain
	282	clear directions next to the object code saying where to find the
	283	Corresponding Source. Regardless of what server hosts the
	284	Corresponding Source, you remain obligated to ensure that it is
	285	available for as long as needed to satisfy these requirements.
	286
	287	e) Convey the object code using peer-to-peer transmission, provided
	288	you inform other peers where the object code and Corresponding
	289	Source of the work are being offered to the general public at no
	290	charge under subsection 6d.
	291
	292	A separable portion of the object code, whose source code is excluded
	293	from the Corresponding Source as a System Library, need not be
	294	included in conveying the object code work.
	295
	296	A "User Product" is either (1) a "consumer product", which means any
	297	tangible personal property which is normally used for personal, family,
	298	or household purposes, or (2) anything designed or sold for incorporation
	299	into a dwelling. In determining whether a product is a consumer product,
	300	doubtful cases shall be resolved in favor of coverage. For a particular
	301	product received by a particular user, "normally used" refers to a
	302	typical or common use of that class of product, regardless of the status
	303	of the particular user or of the way in which the particular user
	304	actually uses, or expects or is expected to use, the product. A product
	305	is a consumer product regardless of whether the product has substantial
	306	commercial, industrial or non-consumer uses, unless such uses represent
	307	the only significant mode of use of the product.
	308
	309	"Installation Information" for a User Product means any methods,
	310	procedures, authorization keys, or other information required to install
	311	and execute modified versions of a covered work in that User Product from
	312	a modified version of its Corresponding Source. The information must
	313	suffice to ensure that the continued functioning of the modified object
	314	code is in no case prevented or interfered with solely because
	315	modification has been made.
	316
	317	If you convey an object code work under this section in, or with, or
	318	specifically for use in, a User Product, and the conveying occurs as
	319	part of a transaction in which the right of possession and use of the
	320	User Product is transferred to the recipient in perpetuity or for a
	321	fixed term (regardless of how the transaction is characterized), the
	322	Corresponding Source conveyed under this section must be accompanied
	323	by the Installation Information. But this requirement does not apply
	324	if neither you nor any third party retains the ability to install
	325	modified object code on the User Product (for example, the work has
	326	been installed in ROM).
	327
	328	The requirement to provide Installation Information does not include a
	329	requirement to continue to provide support service, warranty, or updates
	330	for a work that has been modified or installed by the recipient, or for
	331	the User Product in which it has been modified or installed. Access to a
	332	network may be denied when the modification itself materially and
	333	adversely affects the operation of the network or violates the rules and
	334	protocols for communication across the network.
	335
	336	Corresponding Source conveyed, and Installation Information provided,
	337	in accord with this section must be in a format that is publicly
	338	documented (and with an implementation available to the public in
	339	source code form), and must require no special password or key for
	340	unpacking, reading or copying.
	341
	342	7. Additional Terms.
	343
	344	"Additional permissions" are terms that supplement the terms of this
	345	License by making exceptions from one or more of its conditions.
	346	Additional permissions that are applicable to the entire Program shall
	347	be treated as though they were included in this License, to the extent
	348	that they are valid under applicable law. If additional permissions
	349	apply only to part of the Program, that part may be used separately
	350	under those permissions, but the entire Program remains governed by
	351	this License without regard to the additional permissions.
	352
	353	When you convey a copy of a covered work, you may at your option
	354	remove any additional permissions from that copy, or from any part of
	355	it. (Additional permissions may be written to require their own
	356	removal in certain cases when you modify the work.) You may place
	357	additional permissions on material, added by you to a covered work,
	358	for which you have or can give appropriate copyright permission.
	359
	360	Notwithstanding any other provision of this License, for material you
	361	add to a covered work, you may (if authorized by the copyright holders of
	362	that material) supplement the terms of this License with terms:
	363
	364	a) Disclaiming warranty or limiting liability differently from the
	365	terms of sections 15 and 16 of this License; or
	366
	367	b) Requiring preservation of specified reasonable legal notices or
	368	author attributions in that material or in the Appropriate Legal
	369	Notices displayed by works containing it; or
	370
	371	c) Prohibiting misrepresentation of the origin of that material, or
	372	requiring that modified versions of such material be marked in
	373	reasonable ways as different from the original version; or
	374
	375	d) Limiting the use for publicity purposes of names of licensors or
	376	authors of the material; or
	377
	378	e) Declining to grant rights under trademark law for use of some
	379	trade names, trademarks, or service marks; or
	380
	381	f) Requiring indemnification of licensors and authors of that
	382	material by anyone who conveys the material (or modified versions of
	383	it) with contractual assumptions of liability to the recipient, for
	384	any liability that these contractual assumptions directly impose on
	385	those licensors and authors.
	386
	387	All other non-permissive additional terms are considered "further
	388	restrictions" within the meaning of section 10. If the Program as you
	389	received it, or any part of it, contains a notice stating that it is
	390	governed by this License along with a term that is a further
	391	restriction, you may remove that term. If a license document contains
	392	a further restriction but permits relicensing or conveying under this
	393	License, you may add to a covered work material governed by the terms
	394	of that license document, provided that the further restriction does
	395	not survive such relicensing or conveying.
	396
	397	If you add terms to a covered work in accord with this section, you
	398	must place, in the relevant source files, a statement of the
	399	additional terms that apply to those files, or a notice indicating
	400	where to find the applicable terms.
	401
	402	Additional terms, permissive or non-permissive, may be stated in the
	403	form of a separately written license, or stated as exceptions;
	404	the above requirements apply either way.
	405
	406	8. Termination.
	407
	408	You may not propagate or modify a covered work except as expressly
	409	provided under this License. Any attempt otherwise to propagate or
	410	modify it is void, and will automatically terminate your rights under
	411	this License (including any patent licenses granted under the third
	412	paragraph of section 11).
	413
	414	However, if you cease all violation of this License, then your
	415	license from a particular copyright holder is reinstated (a)
	416	provisionally, unless and until the copyright holder explicitly and
	417	finally terminates your license, and (b) permanently, if the copyright
	418	holder fails to notify you of the violation by some reasonable means
	419	prior to 60 days after the cessation.
	420
	421	Moreover, your license from a particular copyright holder is
	422	reinstated permanently if the copyright holder notifies you of the
	423	violation by some reasonable means, this is the first time you have
	424	received notice of violation of this License (for any work) from that
	425	copyright holder, and you cure the violation prior to 30 days after
	426	your receipt of the notice.
	427
	428	Termination of your rights under this section does not terminate the
	429	licenses of parties who have received copies or rights from you under
	430	this License. If your rights have been terminated and not permanently
	431	reinstated, you do not qualify to receive new licenses for the same
	432	material under section 10.
	433
	434	9. Acceptance Not Required for Having Copies.
	435
	436	You are not required to accept this License in order to receive or
	437	run a copy of the Program. Ancillary propagation of a covered work
	438	occurring solely as a consequence of using peer-to-peer transmission
	439	to receive a copy likewise does not require acceptance. However,
	440	nothing other than this License grants you permission to propagate or
	441	modify any covered work. These actions infringe copyright if you do
	442	not accept this License. Therefore, by modifying or propagating a
	443	covered work, you indicate your acceptance of this License to do so.
	444
	445	10. Automatic Licensing of Downstream Recipients.
	446
	447	Each time you convey a covered work, the recipient automatically
	448	receives a license from the original licensors, to run, modify and
	449	propagate that work, subject to this License. You are not responsible
	450	for enforcing compliance by third parties with this License.
	451
	452	An "entity transaction" is a transaction transferring control of an
	453	organization, or substantially all assets of one, or subdividing an
	454	organization, or merging organizations. If propagation of a covered
	455	work results from an entity transaction, each party to that
	456	transaction who receives a copy of the work also receives whatever
	457	licenses to the work the party's predecessor in interest had or could
	458	give under the previous paragraph, plus a right to possession of the
	459	Corresponding Source of the work from the predecessor in interest, if
	460	the predecessor has it or can get it with reasonable efforts.
	461
	462	You may not impose any further restrictions on the exercise of the
	463	rights granted or affirmed under this License. For example, you may
	464	not impose a license fee, royalty, or other charge for exercise of
	465	rights granted under this License, and you may not initiate litigation
	466	(including a cross-claim or counterclaim in a lawsuit) alleging that
	467	any patent claim is infringed by making, using, selling, offering for
	468	sale, or importing the Program or any portion of it.
	469
	470	11. Patents.
	471
	472	A "contributor" is a copyright holder who authorizes use under this
	473	License of the Program or a work on which the Program is based. The
	474	work thus licensed is called the contributor's "contributor version".
	475
	476	A contributor's "essential patent claims" are all patent claims
	477	owned or controlled by the contributor, whether already acquired or
	478	hereafter acquired, that would be infringed by some manner, permitted
	479	by this License, of making, using, or selling its contributor version,
	480	but do not include claims that would be infringed only as a
	481	consequence of further modification of the contributor version. For
	482	purposes of this definition, "control" includes the right to grant
	483	patent sublicenses in a manner consistent with the requirements of
	484	this License.
	485
	486	Each contributor grants you a non-exclusive, worldwide, royalty-free
	487	patent license under the contributor's essential patent claims, to
	488	make, use, sell, offer for sale, import and otherwise run, modify and
	489	propagate the contents of its contributor version.
	490
	491	In the following three paragraphs, a "patent license" is any express
	492	agreement or commitment, however denominated, not to enforce a patent
	493	(such as an express permission to practice a patent or covenant not to
	494	sue for patent infringement). To "grant" such a patent license to a
	495	party means to make such an agreement or commitment not to enforce a
	496	patent against the party.
	497
	498	If you convey a covered work, knowingly relying on a patent license,
	499	and the Corresponding Source of the work is not available for anyone
	500	to copy, free of charge and under the terms of this License, through a
	501	publicly available network server or other readily accessible means,
	502	then you must either (1) cause the Corresponding Source to be so
	503	available, or (2) arrange to deprive yourself of the benefit of the
	504	patent license for this particular work, or (3) arrange, in a manner
	505	consistent with the requirements of this License, to extend the patent
	506	license to downstream recipients. "Knowingly relying" means you have
	507	actual knowledge that, but for the patent license, your conveying the
	508	covered work in a country, or your recipient's use of the covered work
	509	in a country, would infringe one or more identifiable patents in that
	510	country that you have reason to believe are valid.
	511
	512	If, pursuant to or in connection with a single transaction or
	513	arrangement, you convey, or propagate by procuring conveyance of, a
	514	covered work, and grant a patent license to some of the parties
	515	receiving the covered work authorizing them to use, propagate, modify
	516	or convey a specific copy of the covered work, then the patent license
	517	you grant is automatically extended to all recipients of the covered
	518	work and works based on it.
	519
	520	A patent license is "discriminatory" if it does not include within
	521	the scope of its coverage, prohibits the exercise of, or is
	522	conditioned on the non-exercise of one or more of the rights that are
	523	specifically granted under this License. You may not convey a covered
	524	work if you are a party to an arrangement with a third party that is
	525	in the business of distributing software, under which you make payment
	526	to the third party based on the extent of your activity of conveying
	527	the work, and under which the third party grants, to any of the
	528	parties who would receive the covered work from you, a discriminatory
	529	patent license (a) in connection with copies of the covered work
	530	conveyed by you (or copies made from those copies), or (b) primarily
	531	for and in connection with specific products or compilations that
	532	contain the covered work, unless you entered into that arrangement,
	533	or that patent license was granted, prior to 28 March 2007.
	534
	535	Nothing in this License shall be construed as excluding or limiting
	536	any implied license or other defenses to infringement that may
	537	otherwise be available to you under applicable patent law.
	538
	539	12. No Surrender of Others' Freedom.
	540
	541	If conditions are imposed on you (whether by court order, agreement or
	542	otherwise) that contradict the conditions of this License, they do not
	543	excuse you from the conditions of this License. If you cannot convey a
	544	covered work so as to satisfy simultaneously your obligations under this
	545	License and any other pertinent obligations, then as a consequence you may
	546	not convey it at all. For example, if you agree to terms that obligate you
	547	to collect a royalty for further conveying from those to whom you convey
	548	the Program, the only way you could satisfy both those terms and this
	549	License would be to refrain entirely from conveying the Program.
	550
	551	13. Use with the GNU Affero General Public License.
	552
	553	Notwithstanding any other provision of this License, you have
	554	permission to link or combine any covered work with a work licensed
	555	under version 3 of the GNU Affero General Public License into a single
	556	combined work, and to convey the resulting work. The terms of this
	557	License will continue to apply to the part which is the covered work,
	558	but the special requirements of the GNU Affero General Public License,
	559	section 13, concerning interaction through a network will apply to the
	560	combination as such.
	561
	562	14. Revised Versions of this License.
	563
	564	The Free Software Foundation may publish revised and/or new versions of
	565	the GNU General Public License from time to time. Such new versions will
	566	be similar in spirit to the present version, but may differ in detail to
	567	address new problems or concerns.
	568
	569	Each version is given a distinguishing version number. If the
	570	Program specifies that a certain numbered version of the GNU General
	571	Public License "or any later version" applies to it, you have the
	572	option of following the terms and conditions either of that numbered
	573	version or of any later version published by the Free Software
	574	Foundation. If the Program does not specify a version number of the
	575	GNU General Public License, you may choose any version ever published
	576	by the Free Software Foundation.
	577
	578	If the Program specifies that a proxy can decide which future
	579	versions of the GNU General Public License can be used, that proxy's
	580	public statement of acceptance of a version permanently authorizes you
	581	to choose that version for the Program.
	582
	583	Later license versions may give you additional or different
	584	permissions. However, no additional obligations are imposed on any
	585	author or copyright holder as a result of your choosing to follow a
	586	later version.
	587
	588	15. Disclaimer of Warranty.
	589
	590	THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
	591	APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
	592	HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
	593	OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
	594	THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
	595	PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
	596	IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
	597	ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
	598
	599	16. Limitation of Liability.
	600
	601	IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
	602	WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
	603	THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
	604	GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
	605	USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
	606	DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
	607	PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
	608	EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
	609	SUCH DAMAGES.
	610
	611	17. Interpretation of Sections 15 and 16.
	612
	613	If the disclaimer of warranty and limitation of liability provided
	614	above cannot be given local legal effect according to their terms,
	615	reviewing courts shall apply local law that most closely approximates
	616	an absolute waiver of all civil liability in connection with the
	617	Program, unless a warranty or assumption of liability accompanies a
	618	copy of the Program in return for a fee.
	619
	620	END OF TERMS AND CONDITIONS
	621
	622	How to Apply These Terms to Your New Programs
	623
	624	If you develop a new program, and you want it to be of the greatest
	625	possible use to the public, the best way to achieve this is to make it
	626	free software which everyone can redistribute and change under these terms.
	627
	628	To do so, attach the following notices to the program. It is safest
	629	to attach them to the start of each source file to most effectively
	630	state the exclusion of warranty; and each file should have at least
	631	the "copyright" line and a pointer to where the full notice is found.
	632
	633	<one line to give the program's name and a brief idea of what it does.>
	634	Copyright (C) <year> <name of author>
	635
	636	This program is free software: you can redistribute it and/or modify
	637	it under the terms of the GNU General Public License as published by
	638	the Free Software Foundation, either version 3 of the License, or
	639	(at your option) any later version.
	640
	641	This program is distributed in the hope that it will be useful,
	642	but WITHOUT ANY WARRANTY; without even the implied warranty of
	643	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	644	GNU General Public License for more details.
	645
	646	You should have received a copy of the GNU General Public License
	647	along with this program. If not, see <http://www.gnu.org/licenses/>.
	648
	649	Also add information on how to contact you by electronic and paper mail.
	650
	651	If the program does terminal interaction, make it output a short
	652	notice like this when it starts in an interactive mode:
	653
	654	<program> Copyright (C) <year> <name of author>
	655	This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
	656	This is free software, and you are welcome to redistribute it
	657	under certain conditions; type `show c' for details.
	658
	659	The hypothetical commands `show w' and `show c' should show the appropriate
	660	parts of the General Public License. Of course, your program's commands
	661	might be different; for a GUI interface, you would use an "about box".
	662
	663	You should also get your employer (if you work as a programmer) or school,
	664	if any, to sign a "copyright disclaimer" for the program, if necessary.
	665	For more information on this, and how to apply and follow the GNU GPL, see
	666	<http://www.gnu.org/licenses/>.
	667
	668	The GNU General Public License does not permit incorporating your program
	669	into proprietary programs. If your program is a subroutine library, you
	670	may consider it more useful to permit linking proprietary applications with
	671	the library. If this is what you want to do, use the GNU Lesser General
	672	Public License instead of this License. But first, please read
	673	<http://www.gnu.org/philosophy/why-not-lgpl.html>.

examples/FreeSans.ttf less more

Binary diff not shown

+51

-0

examples/certificate.pem less more

25	25	r9m5x0V15qZSvj1GWp6hSWIG/NwS+4gvv75Jlx83cr+bTlHgDl8h4seEmj8HhPq1
26	26	j9ZXBr9P2ETiD8OVyZAT3hhSwOg=
27	27	-----END CERTIFICATE-----
	28	-----BEGIN RSA PRIVATE KEY-----
	29	MIIJKgIBAAKCAgEA0T9HMb5b2WZDIAF7+7KZzwAEiXC5misVrY1gmlwvLlSVx1pX
	30	Kx5KrFpwkBMfDs1Zsi03/D46N+kViOmSJY/h5nxpiTdbs1Gld2b1RqFbnXcLmx7e
	31	WVXXouLDcmzoJM1Y7vh26e9j3Uy4Bsew7zfxgnWmbfOA9Sg/rHamQFfJ+Ov9Nglk
	32	AoGPwdIiDWc4+hkKD6HL3B72m3VyD4crDSuTm2vFqUDhXk+Jw3clNQYXHQrOSpDK
	33	st1qPQtEDTQbrmKhSN6jMBRwcwfo39lCZLN02jEfOC2bwHPe+VgcyfCzWgfKHtPl
	34	hqqanSIndDSAc6aF5hzI1vlT2dZNmSWDZ6QBrwharh25QXcnQhDr/9DyHIjgvojR
	35	OsOiSaT4pVvJRBsVm7N/7kVQKvNdbwB8itz+ubLlb5SYahlZNBMpE9RqgchwAwe0
	36	SpjILMBHI90/H89SrZPZ4rMitZiIq5/3mBFEy/7Xio/G5jw/Gp3cHa6SMf/6cqhl
	37	l7binB8s8Yd5c8RvdNunczCobKmbnTMDRdsnjnvWFmiaPJZUdcOtftxUCxYP2tEj
	38	apQL8kjC+K4MjCGkde/5lrd8+yRY6GK6zixxfYb1jka/NFdXBaws4gm8amrsFstk
	39	Y3K2GqrVh44/sG7BNqsl4hxkqyHryay7B413+KUrkiET4PqwSHgtJHPayAMCAwEA
	40	AQKCAgEApOLjPCyP/jkaLg9dXtK3ZynRaWh9qSHIXFFqzVhVCYI34Last9qP508B
	41	IlcfAzAIPWJqmoeCouo2QQQlWRoPXeut0iXgSebNp9Bm+ThPlD7p01u4xNbjLITa
	42	lMGDEPUL3ovGUMOGgy1gWl9jaq4/zpjdBAl9FjKYMlPw4AUNr+xuRPWTbHIiEQ6A
	43	LOWpPVMb3YOWvCdeFtSug9P0tdUf5LpBMQViUkoE+hVaKXVaI1WPh6yfPeFCRUYq
	44	Yukr4vfvthdSqqGAlvSlqjdunSHYs9M/kapG8JmeHAg171+QRSKcQDyjwsGPQsFW
	45	K7jve7K+Er2d+eDRFXhM/6BS8wmHFLP5BtHY/XCCZdjcJShIrGWK/Arepzh5TPpe
	46	lIriZBzFBdtLNDaVs0Fj7C+r5ERYulgrF8gwEfPXxFen4vp4gjP3fRnApXgLfEGu
	47	2Cj7SR62nZrRWKBuOYhaoVGt1zdoP7mmcL32/Kg78ItteaNXG07ICogXBoTl0Tj0
	48	N0wPpFG280amcJLB2tSwYyiIF53XyNazKxhgpBHnt1/y+peQfZadncQ/nImmM0f6
	49	GTql3ToEMKj9V3nrYUQhRVEmltCrfJA8pVjFJkp0AjlyZOf/FgcSFNvWbdn0t6vE
	50	EOPU6RklpK0X0Go7B3ywOEqAu51oxo0QgUdRe6v2nzv7Xeuh9FkCggEBAPUV6JTg
	51	uqjWxq7XNA3RljCy8NPzTsT7AS7XwLBD/+JcICXjQQ2SVqMzx7SftGucGw6/8GKx
	52	HRXwp67k73iifiiQ7f1xOsXXgVs7aDg1MT7UE9KOVuY0r74P3No13nSfNYzOMBjh
	53	a+FqKO5v8yjZjNwT5ghtHluJqXPQPMeKYzR3ngNlFRzW9cfDQspiHdTSpu9gFE02
	54	iSug9SNxMjRDiWsqBC14qu3S3ynaU5UuKhqw5CVSRj/Y7pN94b01tVXe4Szcf/U0
	55	HXzg33jlf1QshwsdcBXcGpkB5ijtp6koQuAKRHjxeqcpMKIPpxzratlWBPeynvX7
	56	xO+bDultW4z8tr0CggEBANqQy30ZMM64v39bo04cQNrIMJd2ez1c/lqysneQwIuK
	57	1ALfRJbN74/Zy+vlx9VH6tKT2i5o1FP1Nd5BKiRGLd3bTLE+UlweUWrZoJbyz7ns
	58	IuLqGhw9Qy9SaqCfSyGu9Lmn8blCMVDPf1AggB4fuFHhiT+aBK1AidzDM/Usar2H
	59	D2HwfWP3tKARcyzBnWExiDncUau8oRFdfsYL72kb2P3RvtDtsMRLSFHOdd88o1Us
	60	LSQ+T36U3A2UKCteBndBguN+N7zyUNk7DVpfXILKmFj9nDmoYOFsnctG+TYbRmfr
	61	7G/wKDcEtrmK0tpSOLF5QvowO3qDYaYYYGdK5EPbxb8CggEACDRtjt5fIVvfVucZ
	62	dQT5NDQpX88bafjFN149syjzng5bfSk4ek3V3KzVGLToA1o8hafjUkp/oMZntrEv
	63	WyiFdLI1ZXCu+QSX7gf1Gzyco2/SIhBl1FsbLw+04xE+m0ThNA+LCKozRF6bdDAH
	64	QezWjF+WKd4NUB8xrxDfmAaH/6+peI+fv1Fq9P8Sc1gJi6BpukXLKDKVMQK4cjFN
	65	7vX72byUWzlY75FJq0sF1U6wVihp2t4AQA7xHbrvHbh4k6FchHX1Sq4t9opIsPFt
	66	69F5y+N2ZyTxNwIbRG+AV2djpcByPmJHKuV0HVjMzWkMMK5yiCBQtgdxtlvIigQB
	67	Np0XOQKCAQEAw6yYEUJpONmbz/iJppeS1IwfPKq9QL2tliOftX2pdARxNLUQYfay
	68	v9WcRHBuTJrbN3VZAu2lEhlZBcbPZLRTwejgq1oBQCmAeKmnpRxzLp+iyAYQJDIQ
	69	oSAnB/A0wk4xGLmrplEFd7Sc5W6DZPS+/sdtKbzI7Rb3leZI8Pm4AkAVXHiCuen9
	70	EsUsmOgp7ub6b9q4X4k7piFPKx1qVG6zAOIz9DaoZ8SCVYMCcj6Gd+1Z6LXEU64P
	71	qDR5FgJSxZeoB+VrH0TNbv34QW1YlFuusxUyNUhym76zMlczK+aVTNqhzcFzL3aP
	72	5GLNzNmJmhHXDcf6p/9Rf/MY88DPxZTPXwKCAQEAt2cxXMiEWfFwWHufqpahl3Aq
	73	C4yf0EFMhBsOmnDYZ4RDYikFGJog7XY+BOEX0NZ2z2ZghwjmQW/Gm14ISQnww97d
	74	uo/MDuUZvf6aAeh6gRmkiejhIXMwuvxRAwm90TFUiJ4yn8LKp2c1XxX8DMHujlzS
	75	cdUKcFO3OL+eLQazM5M+3qxQuAFDTlBf41d3OJjCOuQ9soBy0Gy9yMhtjFVVmKDw
	76	eArA0lZgskLVcI9JH6bPhv7+5+n26OqMlFjtmbNMwqi/lOoyGwst5b2d9oAMkWQi
	77	QW5pi51MaAwVV8q8NdfUv1twD8lpRV8Rwb2k8rmG5FqSwhOsibSwpu8gf4WYow==
	78	-----END RSA PRIVATE KEY-----

+34

-0

examples/dbgtest.tcl less more

	0	# An example script useful for testing the Jim debugger
	1	# Taken from http://www.nist.gov/msidlibrary/doc/libes93c.ps
	2
	3	set b 1
	4
	5	proc p4 {x} {
	6	return [
	7	expr 5+[expr 1+$x]]
	8	}
	9
	10	set z [
	11	expr 1+[expr 2+[p4 $b]]
	12	]
	13
	14	proc p3 {} {
	15	set m 0
	16	}
	17
	18	proc p2 {} {
	19	set c 4
	20	p3
	21	set d 5
	22	}
	23
	24	proc p1 {} {
	25	set a 2
	26	p2
	27	set a 3
	28	set a 5
	29	}
	30
	31	p1
	32	set k 7
	33	p1

+66

-0

examples/jcov less more

	0	#!/usr/bin/env jimsh
	1	# vim:se syntax=tcl:
	2
	3	# Experimental code coverage for Jim Tcl
	4
	5	set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib]
	6
	7	set opt_all 0
	8	if {[lindex $argv 0] eq "-all"} {
	9	incr opt_all
	10	set argv [lrange $argv 1 end]
	11	}
	12
	13	set argv [lassign $argv argv0]
	14
	15	set coverage($argv0) {}
	16
	17	proc xcov {type file line result name arglist} {
	18	upvar ::coverage($file) info
	19	incr info($line)
	20	}
	21
	22	xtrace xcov
	23
	24	# Catch exit but not error
	25	set rc [catch -noerror -exit {source $argv0} msg opts]
	26
	27	xtrace {}
	28
	29	proc show-coverage {filename} {
	30	set info $::coverage($filename)
	31
	32	puts "=== $filename ==="
	33	set f [open $filename]
	34	set n 0
	35	while {[$f gets buf] >= 0} {
	36	incr n
	37	if {[info exists info($n)]} {
	38	set prefix [format "%4d: " $info($n)]
	39	} else {
	40	set b [string trimleft $buf]
	41	if {$b eq "" \|\| [string match "#" $b] \|\| [string match "\}" $b]} {
	42	set prefix " -: "
	43	} else {
	44	set prefix "####: "
	45	}
	46	}
	47	puts "$prefix$buf"
	48	}
	49	$f close
	50	}
	51
	52	puts [dict keys $coverage]
	53	if {$opt_all} {
	54	foreach filename [lsort [dict keys $coverage]] {
	55	if {$filename in {"" jcov}} {
	56	continue
	57	}
	58	show-coverage $filename
	59	puts ""
	60	}
	61	} else {
	62	show-coverage $argv0
	63	}
	64
	65	#parray coverage

+53

-0

examples/jtime less more

	0	#!/usr/bin/env jimsh
	1	# vim:se syntax=tcl:
	2
	3	# Experimental code coverage for Jim Tcl
	4
	5	set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib]
	6
	7	set argv [lassign $argv argv0]
	8
	9	set jtime::fileinfo($argv0) {}
	10	set jtime::last [clock micros]
	11
	12	proc jtime::xtrace {type file line result name arglist} {
	13	variable fileinfo
	14	variable last
	15	set now [clock micros]
	16
	17	if {![exists fileinfo($file)]} {
	18	set info {}
	19	} else {
	20	set info $fileinfo($file)
	21	}
	22	incr info($line) $($now - $last)
	23	set fileinfo($file) $info
	24
	25	set last $now
	26	}
	27
	28	xtrace jtime::xtrace
	29
	30	# Catch exit but not error
	31	set rc [catch -noerror -exit {source $argv0} msg opts]
	32
	33	xtrace {}
	34
	35	set info $jtime::fileinfo($argv0)
	36
	37	set f [open $argv0]
	38	set n 0
	39	while {[$f gets buf] >= 0} {
	40	incr n
	41	if {[info exists info($n)]} {
	42	set prefix [format "%8d: " $info($n)]
	43	} else {
	44	set b [string trimleft $buf]
	45	if {$b eq "" \|\| [string match "#" $b] \|\| [string match "\}" $b]} {
	46	set prefix " -: "
	47	} else {
	48	set prefix " ####: "
	49	}
	50	}
	51	puts "$prefix$buf"
	52	}

+23

-0

examples/jtrace less more

	0	#!/usr/bin/env jimsh
	1	# vim:se syntax=tcl:
	2
	3	# Experimental code coverage for Jim Tcl
	4
	5	set auto_path [linsert $auto_path 0 [file dirname $argv0]/jimlib]
	6
	7	set argv [lassign $argv argv0]
	8
	9	proc jtime::xtrace {type file line result name arglist} {
	10	set indent [string repeat " " [info level]]
	11	if {[string length $arglist] > 45} {
	12	set arglist [string range $arglist 0 45]...
	13	}
	14	stderr puts "$indent$name [string map {\r \\r \n \\n} $arglist]"
	15	}
	16
	17	xtrace jtime::xtrace
	18
	19	# Catch exit but not error
	20	set rc [catch -noerror -exit {source $argv0} msg opts]
	21
	22	xtrace {}

-51

~~examples/key.pem~~ less more

0		-----BEGIN RSA PRIVATE KEY-----
1		MIIJKgIBAAKCAgEA0T9HMb5b2WZDIAF7+7KZzwAEiXC5misVrY1gmlwvLlSVx1pX
2		Kx5KrFpwkBMfDs1Zsi03/D46N+kViOmSJY/h5nxpiTdbs1Gld2b1RqFbnXcLmx7e
3		WVXXouLDcmzoJM1Y7vh26e9j3Uy4Bsew7zfxgnWmbfOA9Sg/rHamQFfJ+Ov9Nglk
4		AoGPwdIiDWc4+hkKD6HL3B72m3VyD4crDSuTm2vFqUDhXk+Jw3clNQYXHQrOSpDK
5		st1qPQtEDTQbrmKhSN6jMBRwcwfo39lCZLN02jEfOC2bwHPe+VgcyfCzWgfKHtPl
6		hqqanSIndDSAc6aF5hzI1vlT2dZNmSWDZ6QBrwharh25QXcnQhDr/9DyHIjgvojR
7		OsOiSaT4pVvJRBsVm7N/7kVQKvNdbwB8itz+ubLlb5SYahlZNBMpE9RqgchwAwe0
8		SpjILMBHI90/H89SrZPZ4rMitZiIq5/3mBFEy/7Xio/G5jw/Gp3cHa6SMf/6cqhl
9		l7binB8s8Yd5c8RvdNunczCobKmbnTMDRdsnjnvWFmiaPJZUdcOtftxUCxYP2tEj
10		apQL8kjC+K4MjCGkde/5lrd8+yRY6GK6zixxfYb1jka/NFdXBaws4gm8amrsFstk
11		Y3K2GqrVh44/sG7BNqsl4hxkqyHryay7B413+KUrkiET4PqwSHgtJHPayAMCAwEA
12		AQKCAgEApOLjPCyP/jkaLg9dXtK3ZynRaWh9qSHIXFFqzVhVCYI34Last9qP508B
13		IlcfAzAIPWJqmoeCouo2QQQlWRoPXeut0iXgSebNp9Bm+ThPlD7p01u4xNbjLITa
14		lMGDEPUL3ovGUMOGgy1gWl9jaq4/zpjdBAl9FjKYMlPw4AUNr+xuRPWTbHIiEQ6A
15		LOWpPVMb3YOWvCdeFtSug9P0tdUf5LpBMQViUkoE+hVaKXVaI1WPh6yfPeFCRUYq
16		Yukr4vfvthdSqqGAlvSlqjdunSHYs9M/kapG8JmeHAg171+QRSKcQDyjwsGPQsFW
17		K7jve7K+Er2d+eDRFXhM/6BS8wmHFLP5BtHY/XCCZdjcJShIrGWK/Arepzh5TPpe
18		lIriZBzFBdtLNDaVs0Fj7C+r5ERYulgrF8gwEfPXxFen4vp4gjP3fRnApXgLfEGu
19		2Cj7SR62nZrRWKBuOYhaoVGt1zdoP7mmcL32/Kg78ItteaNXG07ICogXBoTl0Tj0
20		N0wPpFG280amcJLB2tSwYyiIF53XyNazKxhgpBHnt1/y+peQfZadncQ/nImmM0f6
21		GTql3ToEMKj9V3nrYUQhRVEmltCrfJA8pVjFJkp0AjlyZOf/FgcSFNvWbdn0t6vE
22		EOPU6RklpK0X0Go7B3ywOEqAu51oxo0QgUdRe6v2nzv7Xeuh9FkCggEBAPUV6JTg
23		uqjWxq7XNA3RljCy8NPzTsT7AS7XwLBD/+JcICXjQQ2SVqMzx7SftGucGw6/8GKx
24		HRXwp67k73iifiiQ7f1xOsXXgVs7aDg1MT7UE9KOVuY0r74P3No13nSfNYzOMBjh
25		a+FqKO5v8yjZjNwT5ghtHluJqXPQPMeKYzR3ngNlFRzW9cfDQspiHdTSpu9gFE02
26		iSug9SNxMjRDiWsqBC14qu3S3ynaU5UuKhqw5CVSRj/Y7pN94b01tVXe4Szcf/U0
27		HXzg33jlf1QshwsdcBXcGpkB5ijtp6koQuAKRHjxeqcpMKIPpxzratlWBPeynvX7
28		xO+bDultW4z8tr0CggEBANqQy30ZMM64v39bo04cQNrIMJd2ez1c/lqysneQwIuK
29		1ALfRJbN74/Zy+vlx9VH6tKT2i5o1FP1Nd5BKiRGLd3bTLE+UlweUWrZoJbyz7ns
30		IuLqGhw9Qy9SaqCfSyGu9Lmn8blCMVDPf1AggB4fuFHhiT+aBK1AidzDM/Usar2H
31		D2HwfWP3tKARcyzBnWExiDncUau8oRFdfsYL72kb2P3RvtDtsMRLSFHOdd88o1Us
32		LSQ+T36U3A2UKCteBndBguN+N7zyUNk7DVpfXILKmFj9nDmoYOFsnctG+TYbRmfr
33		7G/wKDcEtrmK0tpSOLF5QvowO3qDYaYYYGdK5EPbxb8CggEACDRtjt5fIVvfVucZ
34		dQT5NDQpX88bafjFN149syjzng5bfSk4ek3V3KzVGLToA1o8hafjUkp/oMZntrEv
35		WyiFdLI1ZXCu+QSX7gf1Gzyco2/SIhBl1FsbLw+04xE+m0ThNA+LCKozRF6bdDAH
36		QezWjF+WKd4NUB8xrxDfmAaH/6+peI+fv1Fq9P8Sc1gJi6BpukXLKDKVMQK4cjFN
37		7vX72byUWzlY75FJq0sF1U6wVihp2t4AQA7xHbrvHbh4k6FchHX1Sq4t9opIsPFt
38		69F5y+N2ZyTxNwIbRG+AV2djpcByPmJHKuV0HVjMzWkMMK5yiCBQtgdxtlvIigQB
39		Np0XOQKCAQEAw6yYEUJpONmbz/iJppeS1IwfPKq9QL2tliOftX2pdARxNLUQYfay
40		v9WcRHBuTJrbN3VZAu2lEhlZBcbPZLRTwejgq1oBQCmAeKmnpRxzLp+iyAYQJDIQ
41		oSAnB/A0wk4xGLmrplEFd7Sc5W6DZPS+/sdtKbzI7Rb3leZI8Pm4AkAVXHiCuen9
42		EsUsmOgp7ub6b9q4X4k7piFPKx1qVG6zAOIz9DaoZ8SCVYMCcj6Gd+1Z6LXEU64P
43		qDR5FgJSxZeoB+VrH0TNbv34QW1YlFuusxUyNUhym76zMlczK+aVTNqhzcFzL3aP
44		5GLNzNmJmhHXDcf6p/9Rf/MY88DPxZTPXwKCAQEAt2cxXMiEWfFwWHufqpahl3Aq
45		C4yf0EFMhBsOmnDYZ4RDYikFGJog7XY+BOEX0NZ2z2ZghwjmQW/Gm14ISQnww97d
46		uo/MDuUZvf6aAeh6gRmkiejhIXMwuvxRAwm90TFUiJ4yn8LKp2c1XxX8DMHujlzS
47		cdUKcFO3OL+eLQazM5M+3qxQuAFDTlBf41d3OJjCOuQ9soBy0Gy9yMhtjFVVmKDw
48		eArA0lZgskLVcI9JH6bPhv7+5+n26OqMlFjtmbNMwqi/lOoyGwst5b2d9oAMkWQi
49		QW5pi51MaAwVV8q8NdfUv1twD8lpRV8Rwb2k8rmG5FqSwhOsibSwpu8gf4WYow==
50		-----END RSA PRIVATE KEY-----

+61

-0

examples/redis-pubsub.tcl less more

	0	#!/usr/bin/env jimsh
	1
	2	# Requires the redis extension
	3	package require redis
	4
	5	# A redis server should be running either on localhost 6379
	6	# or on the given host port
	7	#
	8	# Usage: redis-pubsub.tcl ?pub\|sub? ?host:addr?
	9	#
	10	# If pub or sub is not given, forks and does both
	11
	12	if {[lindex $argv 0] in {pub sub}} {
	13	# Run in single process mode
	14	set argv [lassign $argv op]
	15	} else {
	16	# fork before connecting so that both processes don't share
	17	# a connection
	18	if {[os.fork] == 0} {
	19	# child subscribes
	20	set op sub
	21	} else {
	22	set op pub
	23	}
	24	}
	25
	26	try {
	27	lassign $argv addr
	28	if {$addr eq ""} {
	29	set addr localhost:6379
	30	}
	31	set r [redis [socket stream $addr]]
	32	} on error msg {
	33	puts [errorInfo $msg]
	34	exit 1
	35	}
	36
	37	if {$op eq "sub"} {
	38	$r SUBSCRIBE chin
	39	$r SUBSCRIBE chan
	40
	41	$r readable {
	42	after cancel $afterid
	43	set result [$r read]
	44	puts "$op: $result"
	45	set afterid [after 2000 {incr done}]
	46	}
	47	# If no message for 2 seconds, stop
	48	set afterid [after 2000 {incr done}]
	49	vwait done
	50	puts "$op: quitting on idle"
	51	} else {
	52	loop i 1 15 {
	53	$r PUBLISH chan PONG$i
	54	puts "$op: chan PONG$i"
	55	after 250
	56	$r PUBLISH chin PING$i
	57	puts "$op: chin PING$i"
	58	after 250
	59	}
	60	}

+54

-0

examples/redis.tcl less more

	0	#!/usr/bin/env jimsh
	1
	2	# A simple test of the redis extension
	3
	4	# Requires the redis extension
	5	package require redis
	6
	7	# A redis server should be running either on localhost 6379
	8	# or on the given address (e.g. host:port)
	9	try {
	10	lassign $argv addr
	11	if {$addr eq ""} {
	12	set addr localhost:6379
	13	}
	14	set r [redis [socket stream $addr]]
	15	} on error msg {
	16	puts [errorInfo $msg]
	17	exit 1
	18	}
	19
	20	puts "KEYS: [$r KEYS *]"
	21
	22	# Set a hash
	23	set env(testing) yes
	24	$r HMSET env {*}$env
	25
	26	set result [$r HGET env testing]
	27	puts "HGET: testing=$result"
	28
	29	set size [$r HLEN env]
	30	puts "Size of env is $size"
	31
	32	set time [time {
	33	$r HGETALL env
	34	} 100]
	35	puts "HGETALL: $time"
	36
	37	# a multi-command transation
	38	$r MULTI
	39	$r SET a A1
	40	$r SET b B2
	41	$r EXEC
	42	puts "MGET: [$r MGET a b]"
	43
	44	# disard
	45	$r MULTI
	46	$r SET a ~A1
	47	$r SET b ~B2
	48	$r DISCARD
	49	puts "MGET (DISCARD): [$r MGET a b]"
	50
	51	set result [$r HGET env testing]
	52
	53	$r close

+28

-0

examples/sdlcircles.tcl less more

	0	package require sdl
	1
	2	set xres 1024
	3	set yres 768
	4	set s [sdl.screen $xres $yres "Jim SDL Circles"]
	5
	6	proc drawlist {s list} {
	7	foreach item $list {
	8	$s {*}$item
	9	}
	10	}
	11
	12	proc rand_circle {xres yres maxradius alpha} {
	13	list fcircle [rand $xres] [rand $yres] [rand $maxradius] [rand 256] [rand 256] [rand 256] $alpha
	14	}
	15
	16	loop i 0 200 {
	17	set commands {}
	18	loop j 0 1000 {
	19	lappend commands [rand_circle $xres $yres 40 100]
	20	if {$j % 50 == 0} {
	21	#$s clear 200 200 200
	22	drawlist $s $commands
	23	$s flip
	24	sleep 0.1
	25	}
	26	}
	27	}

+96

-0

examples/sdlevents.tcl less more

	0	package require sdl
	1	package require oo
	2
	3	set xres 640
	4	set yres 384
	5	set s [sdl.screen $xres $yres "Jim Tcl - SDL, Eventloop integration"]
	6
	7	set col(cyan) {0 255 255}
	8	set col(yellow) {255 255 0}
	9	set col(red) {255 0 0}
	10	set col(green) {0 255 0}
	11	set col(white) {255 255 255}
	12	set col(blue) {0 0 255}
	13	set ncols [dict size $col]
	14
	15	set grey {50 50 50}
	16
	17	class ball {
	18	name -
	19	pos {x 256 y 256}
	20	color {255 255 255}
	21	res {x 512 y 512}
	22	delta {x 3 y 3}
	23	radius 40
	24	havetext 1
	25	}
	26
	27	ball method draw {s} {
	28	$s fcircle $pos(x) $pos(y) $radius {*}$color
	29	if {$havetext} {
	30	$s text "($pos(x),$pos(y))" $pos(x)-25 $pos(y)-5 0 0 0
	31	}
	32	foreach xy {x y} {
	33	incr pos($xy) $delta($xy)
	34	if {$pos($xy) <= $radius + $delta($xy) \|\| $pos($xy) >= $res($xy) - $radius - $delta($xy) \|\| [rand 50] == 1} {
	35	set delta($xy) $(-1 * $delta($xy))
	36	incr pos($xy) $(2 * $delta($xy))
	37	}
	38	}
	39	}
	40
	41	ball method setvar {name_ value_} {
	42	set $name_ $value_
	43	}
	44
	45	try {
	46	$s font [file dirname [info script]]/FreeSans.ttf 12
	47	set havetext 1
	48	} on error msg {
	49	puts $msg
	50	set havetext 0
	51	}
	52
	53	foreach c [dict keys $col] {
	54	set b [ball]
	55	$b setvar name $c
	56	$b setvar res(x) $xres
	57	$b setvar res(y) $yres
	58	$b setvar pos(x) $($xres/2)
	59	$b setvar pos(y) $($yres/2)
	60	$b setvar color [list {*}$col($c) 150]
	61	$b setvar havetext $havetext
	62	lappend balls $b
	63	}
	64
	65	proc draw {balls} {s} {
	66	$s clear {*}$::grey
	67	foreach ball $balls {
	68	$ball draw $s
	69	}
	70	$s flip
	71	}
	72
	73	# Example of integrating the Tcl event loop with SDL
	74	# We need to always be polling SDL, and also run the Tcl event loop
	75
	76	# The Tcl event loop runs from within the SDL poll loop via
	77	# a (non-blocking) call to update
	78	proc heartbeat {} {
	79	puts $([clock millis] % 1000000)
	80	after 250 heartbeat
	81	}
	82
	83	set t1 [clock millis]
	84	draw $balls
	85	heartbeat
	86	$s poll {
	87	draw $balls
	88	update
	89	set t2 [clock millis]
	90	# 33ms = 30 frames/second
	91	if {$t2 - $t1 < 33} {
	92	after $(33 - ($t2 - $t1))
	93	}
	94	set t1 $t2
	95	}

+65

-0

examples/sdltest.tcl less more

	0	package require sdl
	1
	2	# Basic test of all sdl commands
	3
	4	set xres 640
	5	set yres 384
	6	set s [sdl.screen $xres $yres [info script]]
	7
	8	set cyan {0 255 255}
	9	set yellow {255 255 0}
	10	set red {255 0 0}
	11	set green {0 255 0}
	12	set grey {20 20 20}
	13	set white {255 255 255}
	14	set blue {0 0 255}
	15
	16	$s clear {*}$grey
	17
	18	$s fcircle 320 280 40 {*}$cyan 150
	19	$s circle 320 280 60 {*}$yellow
	20	$s aacircle 320 280 80 {*}$green
	21
	22	$s rectangle 200 100 300 180 {*}$cyan
	23	$s box 210 110 290 170 {*}$yellow 150
	24
	25	set x 20
	26	set y 20
	27	set dy 10
	28	set dx 10
	29	foreach i [range 50] {
	30	set nx $($x + $dx)
	31	set ny $($y + $dy)
	32	$s line $x $y $nx $ny {*}$green
	33	$s aaline $x $($y+30) $nx $($ny+30) {*}$red
	34	set x $nx
	35	set y $ny
	36	set dy $(-$dy)
	37	}
	38
	39	$s rectangle 50 150 150 250 {*}$yellow
	40	foreach i [range 500] {
	41	$s pixel $([rand 100] + 50) $([rand 100] + 150) {*}$white
	42	}
	43
	44	if {[llength $argv]} {
	45	lassign $argv font
	46	} else {
	47	set font [file join [file dirname [info script]] FreeSans.ttf]
	48	}
	49
	50	try {
	51	$s font $font 18
	52	$s text "[file tail $font] 16pt" 20 270 {*}$yellow
	53	$s font $font 14
	54	$s text "[file tail $font] 12pt" 20 300 {*}$green 150
	55	# Note that depending on the font, certain unicode glyphs
	56	# may or may not be rendered.
	57	# Also, need to build with --utf8
	58	$s text "utf-8: \u00bb \u273b \u261e" 20 330 {*}$cyan
	59	} on error msg {
	60	puts $msg
	61	}
	62
	63	$s poll { sleep 0.25 }
	64	$s free

-1

examples/ssl.server less more

5	5	$s readable {
6	6	# Clean up children
7	7	wait -nohang 0
8		set sock [[$s accept addr] ssl -server certificate.pem key.pem]
	8	set sock [[$s accept addr] ssl -server certificate.pem]
9	9	puts "Client address: $addr"
10	10
11	11	# Make this server forking so we can accept multiple

-16

~~examples.api/Makefile~~ less more

0		CFLAGS+= -Wall -g
1		CFLAGS+= -I..
2		LDLIBS += -L.. -ljim
3
4		EXAMPLES= \
5		jim_command \
6		jim_hello \
7		jim_list \
8		jim_obj \
9		jim_return
10
11		all: $(EXAMPLES)
12
13		clean:
14		rm -rf $(EXAMPLES)
15		rm -rf *.core

+17

-0

examples.api/Makefile.in less more

	0	CFLAGS+= -Wall -g
	1	CFLAGS+= -I..
	2	LDFLAGS += @LDFLAGS@
	3	LDLIBS += -L.. -ljim @LDLIBS@
	4
	5	EXAMPLES= \
	6	jim_command \
	7	jim_hello \
	8	jim_list \
	9	jim_obj \
	10	jim_return
	11
	12	all: $(EXAMPLES)
	13
	14	clean:
	15	rm -rf $(EXAMPLES)
	16	rm -rf *.core

+279

-128

jim-aio.c less more

50	50	#include <unistd.h>
51	51	#include <sys/stat.h>
52	52	#endif
	53	#ifdef HAVE_UTIL_H
	54	#include <util.h>
	55	#endif
	56	#ifdef HAVE_PTY_H
	57	#include <pty.h>
	58	#endif
53	59
54	60	#include "jim.h"
55	61	#include "jimiocompat.h"

94	100
95	101	#define AIO_KEEPOPEN 1
96	102	#define AIO_NODELETE 2
	103	#define AIO_EOF 4
97	104
98	105	#if defined(JIM_IPV6)
99	106	#define IPV6 1

149	156	int (error)(const struct AioFile af);
150	157	const char (strerror)(struct AioFile *af);
151	158	int (verify)(struct AioFile af);
	159	int (eof)(struct AioFile af);
	160	int (pending)(struct AioFile af);
152	161	} JimAioFopsType;
153	162
154	163	typedef struct AioFile

156	165	FILE *fp;
157	166	Jim_Obj *filename;
158	167	int type;
159		int openFlags; /* AIO_KEEPOPEN? keep FILE* */
	168	int flags; /* AIO_KEEPOPEN? keep FILE* */
160	169	int fd;
161		Jim_Obj *rEvent;
162		Jim_Obj *wEvent;
163		Jim_Obj *eEvent;
164	170	int addr_family;
165	171	void *ssl;
166	172	const JimAioFopsType *fops;

207	213	static const char stdio_strerror(struct AioFile af)
208	214	{
209	215	return strerror(errno);
	216	}
	217
	218	static int stdio_eof(struct AioFile *af)
	219	{
	220	return feof(af->fp);
210	221	}
211	222
212	223	static const JimAioFopsType stdio_fops = {

215	226	stdio_getline,
216	227	stdio_error,
217	228	stdio_strerror,
218		NULL
	229	NULL, /* verify */
	230	stdio_eof,
	231	NULL, /* pending */
219	232	};
220	233
221	234	#if defined(JIM_SSL) && !defined(JIM_BOOTSTRAP)

227	240	return SSL_write(af->ssl, buf, len);
228	241	}
229	242
	243	static int ssl_pending(struct AioFile *af)
	244	{
	245	return SSL_pending(af->ssl);
	246	}
	247
230	248	static int ssl_reader(struct AioFile af, char buf, int len)
231	249	{
232		return SSL_read(af->ssl, buf, len);
	250	int ret = SSL_read(af->ssl, buf, len);
	251	switch (SSL_get_error(af->ssl, ret)) {
	252	case SSL_ERROR_NONE:
	253	return ret;
	254	case SSL_ERROR_SYSCALL:
	255	case SSL_ERROR_ZERO_RETURN:
	256	if (errno != EAGAIN) {
	257	af->flags \|= AIO_EOF;
	258	}
	259	return 0;
	260	case SSL_ERROR_SSL:
	261	default:
	262	if (errno == EAGAIN) {
	263	return 0;
	264	}
	265	af->flags \|= AIO_EOF;
	266	return -1;
	267	}
	268	}
	269
	270	static int ssl_eof(struct AioFile *af)
	271	{
	272	return (af->flags & AIO_EOF);
233	273	}
234	274
235	275	static const char ssl_getline(struct AioFile af, char *buf, int len)
236	276	{
237	277	size_t i;
238		for (i = 0; i < len + 1; i++) {
239		if (SSL_read(af->ssl, &buf[i], 1) != 1) {
240		if (i == 0) {
241		return NULL;
242		}
	278	for (i = 0; i < len - 1 && !ssl_eof(af); i++) {
	279	int ret = ssl_reader(af, &buf[i], 1);
	280	if (ret != 1) {
243	281	break;
244	282	}
245	283	if (buf[i] == '\n') {
	284	i++;
246	285	break;
247	286	}
248	287	}
249	288	buf[i] = '\0';
	289	if (i == 0 && ssl_eof(af)) {
	290	return NULL;
	291	}
250	292	return buf;
251	293	}
252	294
253	295	static int ssl_error(const struct AioFile *af)
254	296	{
255		if (ERR_peek_error() == 0) {
256		return JIM_OK;
257		}
258
	297	int ret = SSL_get_error(af->ssl, 0);
	298	/* XXX should we be following the same logic as ssl_reader() here? */
	299	if (ret == SSL_ERROR_ZERO_RETURN \|\| ret == SSL_ERROR_NONE) {
	300	return JIM_OK;
	301	}
	302	if (ret == SSL_ERROR_SYSCALL) {
	303	return stdio_error(af);
	304	}
259	305	return JIM_ERR;
260	306	}
261	307

294	340	ssl_getline,
295	341	ssl_error,
296	342	ssl_strerror,
297		ssl_verify
	343	ssl_verify,
	344	ssl_eof,
	345	ssl_pending,
298	346	};
299	347	#endif /* JIM_BOOTSTRAP */
300	348

366	414	}
367	415	#endif
368	416
369		static int JimParseIPv6Address(Jim_Interp interp, const char hostport, union sockaddr_any sa, socklen_t salen)
	417	static int JimParseIPv6Address(Jim_Interp interp, int socktype, const char hostport, union sockaddr_any sa, socklen_t salen)
370	418	{
371	419	#if IPV6
372	420	/*

410	458
411	459	memset(&req, '\0', sizeof(req));
412	460	req.ai_family = PF_INET6;
	461	req.ai_socktype = socktype;
413	462
414	463	if (getaddrinfo(sthost, stport, &req, &ai)) {
415		Jim_SetResultFormatted(interp, "Not a valid address: %s", hostport);
	464	Jim_SetResultFormatted(interp, "Not a valid address: %s:%s", sthost, stport);
416	465	ret = JIM_ERR;
417	466	}
418	467	else {

429	478	#endif
430	479	}
431	480
432		static int JimParseIpAddress(Jim_Interp interp, const char hostport, union sockaddr_any sa, socklen_t salen)
	481	static int JimParseIpAddress(Jim_Interp interp, int socktype, const char hostport, union sockaddr_any sa, socklen_t salen)
433	482	{
434	483	/* An IPv4 addr/port looks like:
435	484	* 192.168.1.5

458	507
459	508	memset(&req, '\0', sizeof(req));
460	509	req.ai_family = PF_INET;
	510	req.ai_socktype = socktype;
461	511
462	512	if (getaddrinfo(sthost, stport, &req, &ai)) {
463	513	ret = JIM_ERR;

487	537	}
488	538	#endif
489	539
490		static int JimParseSocketAddress(Jim_Interp interp, int family, const char addr, union sockaddr_any sa, socklen_t salen)
	540	static int JimParseSocketAddress(Jim_Interp interp, int family, int socktype, const char addr, union sockaddr_any sa, socklen_t salen)
491	541	{
492	542	switch (family) {
493	543	#if UNIX_SOCKETS

495	545	return JimParseDomainAddress(interp, addr, sa, salen);
496	546	#endif
497	547	case PF_INET6:
498		return JimParseIPv6Address(interp, addr, sa, salen);
	548	return JimParseIPv6Address(interp, socktype, addr, sa, salen);
499	549	case PF_INET:
500		return JimParseIpAddress(interp, addr, sa, salen);
	550	return JimParseIpAddress(interp, socktype, addr, sa, salen);
501	551	}
502	552	return JIM_ERR;
503	553	}

540	590	default:
541	591	/* Otherwise just an empty address */
542	592	addr = "";
543		fprintf(stderr, "%s:%d", __FILE__, __LINE__);
544	593	break;
545	594	}
546	595

605	654	JIM_NOTUSED(interp);
606	655
607	656	#if UNIX_SOCKETS
608		if (af->addr_family == PF_UNIX && (af->openFlags & AIO_NODELETE) == 0) {
	657	if (af->addr_family == PF_UNIX && (af->flags & AIO_NODELETE) == 0) {
609	658	/* If this is bound, delete the socket file now */
610	659	Jim_Obj *filenameObj = aio_sockname(interp, af);
611	660	if (filenameObj) {

629	678	SSL_free(af->ssl);
630	679	}
631	680	#endif
632		if (!(af->openFlags & AIO_KEEPOPEN)) {
	681	if (!(af->flags & AIO_KEEPOPEN)) {
633	682	fclose(af->fp);
634	683	}
635	684

642	691	char buf[AIO_BUF_LEN];
643	692	Jim_Obj *objPtr;
644	693	int nonewline = 0;
	694	int pending = 0;
645	695	jim_wide neededLen = -1; /* -1 is "read as much as possible" */
646
647		if (argc && Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) {
648		nonewline = 1;
	696	static const char * const options[] = { "-pending", "-nonewline", NULL };
	697	enum { OPT_PENDING, OPT_NONEWLINE };
	698	int option;
	699
	700	if (argc) {
	701	if (*Jim_String(argv[0]) == '-') {
	702	if (Jim_GetEnum(interp, argv[0], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
	703	return JIM_ERR;
	704	}
	705	switch (option) {
	706	case OPT_PENDING:
	707	if (!af->fops->pending) {
	708	Jim_SetResultString(interp, "-pending not supported on this connection type", -1);
	709	return JIM_ERR;
	710	}
	711	pending++;
	712	break;
	713	case OPT_NONEWLINE:
	714	nonewline++;
	715	break;
	716	}
	717	}
	718	else {
	719	if (Jim_GetWide(interp, argv[0], &neededLen) != JIM_OK)
	720	return JIM_ERR;
	721	if (neededLen < 0) {
	722	Jim_SetResultString(interp, "invalid parameter: negative len", -1);
	723	return JIM_ERR;
	724	}
	725	}
	726	argc--;
649	727	argv++;
650		argc--;
651		}
652		if (argc == 1) {
653		if (Jim_GetWide(interp, argv[0], &neededLen) != JIM_OK)
654		return JIM_ERR;
655		if (neededLen < 0) {
656		Jim_SetResultString(interp, "invalid parameter: negative len", -1);
657		return JIM_ERR;
658		}
659		}
660		else if (argc) {
	728	}
	729	if (argc) {
661	730	return -1;
662	731	}
663	732	objPtr = Jim_NewStringObj(interp, NULL, 0);

671	740	else {
672	741	readlen = (neededLen > AIO_BUF_LEN ? AIO_BUF_LEN : neededLen);
673	742	}
674		retval = af->fops->reader(af, buf, readlen);
	743	retval = af->fops->reader(af, buf, pending ? 1 : readlen);
675	744	if (retval > 0) {
676	745	Jim_AppendString(interp, objPtr, buf, retval);
677	746	if (neededLen != -1) {
678	747	neededLen -= retval;
679	748	}
680		}
681		if (retval != readlen)
682		break;
	749	else if (pending) {
	750	/* If pending was specified, after we do the initial read,
	751	* we do a second read to fetch any buffered data
	752	*/
	753	neededLen = af->fops->pending(af);
	754	}
	755	}
	756	if (retval <= 0) {
	757	break;
	758	}
683	759	}
684	760	/* Check for error conditions */
685	761	if (JimCheckStreamError(interp, af)) {

823	899
824	900	len = Jim_Length(objPtr);
825	901
826		if (len == 0 && feof(af->fp)) {
	902	if (len == 0 && af->fops->eof(af)) {
827	903	/* On EOF returns -1 if varName was specified */
828	904	len = -1;
829	905	}

917	993	const char *addr = Jim_String(argv[1]);
918	994	socklen_t salen;
919	995
920		if (JimParseSocketAddress(interp, af->addr_family, addr, &sa, &salen) != JIM_OK) {
	996	if (JimParseSocketAddress(interp, af->addr_family, SOCK_DGRAM, addr, &sa, &salen) != JIM_OK) {
921	997	return JIM_ERR;
922	998	}
923	999	wdata = Jim_GetString(argv[0], &wlen);

1016	1092	{
1017	1093	AioFile *af = Jim_CmdPrivData(interp);
1018	1094
1019		Jim_SetResultInt(interp, feof(af->fp));
	1095	Jim_SetResultInt(interp, !!af->fops->eof(af));
1020	1096	return JIM_OK;
1021	1097	}
1022	1098

1046	1122	#if UNIX_SOCKETS
1047	1123	case OPT_NODELETE:
1048	1124	if (af->addr_family == PF_UNIX) {
1049		af->openFlags \|= AIO_NODELETE;
	1125	af->flags \|= AIO_NODELETE;
1050	1126	break;
1051	1127	}
1052	1128	/* fall through */

1057	1133	}
1058	1134	}
1059	1135
1060		return Jim_DeleteCommand(interp, Jim_String(argv[0]));
	1136	return Jim_DeleteCommand(interp, argv[0]);
1061	1137	}
1062	1138
1063	1139	static int aio_cmd_seek(Jim_Interp interp, int argc, Jim_Obj const *argv)

1277	1353	}
1278	1354
1279	1355	#ifdef jim_ext_eventloop
1280		static void JimAioFileEventFinalizer(Jim_Interp interp, void clientData)
1281		{
1282		Jim_Obj **objPtrPtr = clientData;
1283
1284		Jim_DecrRefCount(interp, *objPtrPtr);
1285		*objPtrPtr = NULL;
1286		}
1287
1288		static int JimAioFileEventHandler(Jim_Interp interp, void clientData, int mask)
1289		{
1290		Jim_Obj **objPtrPtr = clientData;
1291
1292		return Jim_EvalObjBackground(interp, *objPtrPtr);
1293		}
1294
1295		static int aio_eventinfo(Jim_Interp interp, AioFile af, unsigned mask, Jim_Obj **scriptHandlerObj,
	1356	static int aio_eventinfo(Jim_Interp interp, AioFile af, unsigned mask,
1296	1357	int argc, Jim_Obj * const *argv)
1297	1358	{
1298	1359	if (argc == 0) {
1299	1360	/* Return current script */
1300		if (*scriptHandlerObj) {
1301		Jim_SetResult(interp, *scriptHandlerObj);
	1361	Jim_Obj *objPtr = Jim_FindFileHandler(interp, af->fd, mask);
	1362	if (objPtr) {
	1363	Jim_SetResult(interp, objPtr);
1302	1364	}
1303	1365	return JIM_OK;
1304	1366	}
1305	1367
1306		if (*scriptHandlerObj) {
1307		/* Delete old handler */
1308		Jim_DeleteFileHandler(interp, af->fd, mask);
1309		}
	1368	/* Delete old handler */
	1369	Jim_DeleteFileHandler(interp, af->fd, mask);
1310	1370
1311	1371	/* Now possibly add the new script(s) */
1312		if (Jim_Length(argv[0]) == 0) {
1313		/* Empty script, so done */
1314		return JIM_OK;
1315		}
1316
1317		/* A new script to add */
1318		Jim_IncrRefCount(argv[0]);
1319		*scriptHandlerObj = argv[0];
1320
1321		Jim_CreateFileHandler(interp, af->fd, mask,
1322		JimAioFileEventHandler, scriptHandlerObj, JimAioFileEventFinalizer);
	1372	if (Jim_Length(argv[0])) {
	1373	Jim_CreateScriptFileHandler(interp, af->fd, mask, argv[0]);
	1374	}
1323	1375
1324	1376	return JIM_OK;
1325	1377	}

1328	1380	{
1329	1381	AioFile *af = Jim_CmdPrivData(interp);
1330	1382
1331		return aio_eventinfo(interp, af, JIM_EVENT_READABLE, &af->rEvent, argc, argv);
	1383	return aio_eventinfo(interp, af, JIM_EVENT_READABLE, argc, argv);
1332	1384	}
1333	1385
1334	1386	static int aio_cmd_writable(Jim_Interp interp, int argc, Jim_Obj const *argv)
1335	1387	{
1336	1388	AioFile *af = Jim_CmdPrivData(interp);
1337	1389
1338		return aio_eventinfo(interp, af, JIM_EVENT_WRITABLE, &af->wEvent, argc, argv);
	1390	return aio_eventinfo(interp, af, JIM_EVENT_WRITABLE, argc, argv);
1339	1391	}
1340	1392
1341	1393	static int aio_cmd_onexception(Jim_Interp interp, int argc, Jim_Obj const *argv)
1342	1394	{
1343	1395	AioFile *af = Jim_CmdPrivData(interp);
1344	1396
1345		return aio_eventinfo(interp, af, JIM_EVENT_EXCEPTION, &af->eEvent, argc, argv);
	1397	return aio_eventinfo(interp, af, JIM_EVENT_EXCEPTION, argc, argv);
1346	1398	}
1347	1399	#endif
1348	1400

1353	1405	SSL *ssl;
1354	1406	SSL_CTX *ssl_ctx;
1355	1407	int server = 0;
1356
1357		if (argc == 5) {
1358		if (!Jim_CompareStringImmediate(interp, argv[2], "-server")) {
	1408	const char *sni = NULL;
	1409
	1410	if (argc > 2) {
	1411	static const char * const options[] = { "-server", "-sni", NULL };
	1412	enum { OPT_SERVER, OPT_SNI };
	1413	int option;
	1414
	1415	if (Jim_GetEnum(interp, argv[2], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
1359	1416	return JIM_ERR;
1360	1417	}
1361		server = 1;
1362		}
1363		else if (argc != 2) {
1364		return -1;
	1418	switch (option) {
	1419	case OPT_SERVER:
	1420	if (argc != 4 && argc != 5) {
	1421	return JIM_ERR;
	1422	}
	1423	server = 1;
	1424	break;
	1425
	1426	case OPT_SNI:
	1427	if (argc != 4) {
	1428	return JIM_ERR;
	1429	}
	1430	sni = Jim_String(argv[3]);
	1431	break;
	1432	}
1365	1433	}
1366	1434
1367	1435	if (af->ssl) {

1386	1454	}
1387	1455
1388	1456	if (server) {
1389		if (SSL_use_certificate_file(ssl, Jim_String(argv[3]), SSL_FILETYPE_PEM) != 1) {
	1457	const char *certfile = Jim_String(argv[3]);
	1458	const char *keyfile = (argc == 4) ? certfile : Jim_String(argv[4]);
	1459	if (SSL_use_certificate_file(ssl, certfile, SSL_FILETYPE_PEM) != 1) {
1390	1460	goto out;
1391	1461	}
1392
1393		if (SSL_use_PrivateKey_file(ssl, Jim_String(argv[4]), SSL_FILETYPE_PEM) != 1) {
	1462	if (SSL_use_PrivateKey_file(ssl, keyfile, SSL_FILETYPE_PEM) != 1) {
1394	1463	goto out;
1395	1464	}
1396	1465

1399	1468	}
1400	1469	}
1401	1470	else {
	1471	if (sni) {
	1472	/* Set server name indication if requested */
	1473	SSL_set_tlsext_host_name(ssl, sni);
	1474	}
1402	1475	if (SSL_connect(ssl) != 1) {
1403	1476	goto out;
1404	1477	}

1542	1615
1543	1616	static const jim_subcmd_type aio_command_table[] = {
1544	1617	{ "read",
1545		"?-nonewline? ?len?",
	1618	"?-nonewline\|-pending\|len?",
1546	1619	aio_cmd_read,
1547	1620	0,
1548	1621	2,

1728	1801	#if !defined(JIM_BOOTSTRAP)
1729	1802	#if defined(JIM_SSL)
1730	1803	{ "ssl",
1731		"?-server cert priv?",
	1804	"?-server cert ?priv?\|-sni servername?",
1732	1805	aio_cmd_ssl,
1733	1806	0,
1734	1807	3,

1744	1817	},
1745	1818	#endif
1746	1819	#if defined(HAVE_STRUCT_FLOCK)
1747		{ "lock ?-wait?",
1748		NULL,
	1820	{ "lock",
	1821	"?-wait?",
1749	1822	aio_cmd_lock,
1750	1823	0,
1751	1824	1,

1781	1854	Jim_Obj const argv)
1782	1855	{
1783	1856	const char *mode;
	1857	FILE *fh = NULL;
	1858	const char *filename;
	1859	int fd = -1;
1784	1860
1785	1861	if (argc != 2 && argc != 3) {
1786	1862	Jim_WrongNumArgs(interp, 1, argv, "filename ?mode?");
1787	1863	return JIM_ERR;
1788	1864	}
1789	1865
	1866	filename = Jim_String(argv[1]);
1790	1867	mode = (argc == 3) ? Jim_String(argv[2]) : "r";
1791	1868
1792	1869	#ifdef jim_ext_tclcompat
1793	1870	{
1794		const char *filename = Jim_String(argv[1]);
1795	1871
1796	1872	/* If the filename starts with '\|', use popen instead */
1797	1873	if (*filename == '\|') {

1805	1881	}
1806	1882	}
1807	1883	#endif
1808		return JimMakeChannel(interp, NULL, -1, argv[1], "aio.handle%ld", 0, mode, 0) ? JIM_OK : JIM_ERR;
	1884	#ifndef JIM_ANSIC
	1885	if (mode == 'R' \|\| mode == 'W') {
	1886	/* POSIX flags */
	1887	#ifndef O_NOCTTY
	1888	/* mingw doesn't support this flag */
	1889	#define O_NOCTTY 0
	1890	#endif
	1891	static const char * const modetypes[] = {
	1892	"RDONLY", "WRONLY", "RDWR", "APPEND", "BINARY", "CREAT", "EXCL", "NOCTTY", "TRUNC", NULL
	1893	};
	1894	static const char * const simplemodes[] = {
	1895	"r", "w", "w+"
	1896	};
	1897	static const int modeflags[] = {
	1898	O_RDONLY, O_WRONLY, O_RDWR, O_APPEND, 0, O_CREAT, O_EXCL, O_NOCTTY, O_TRUNC,
	1899	};
	1900	int posixflags = 0;
	1901	int len = Jim_ListLength(interp, argv[2]);
	1902	int i;
	1903	int opt;
	1904
	1905	mode = NULL;
	1906
	1907	for (i = 0; i < len; i++) {
	1908	Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[2], i);
	1909	if (Jim_GetEnum(interp, objPtr, modetypes, &opt, "access mode", JIM_ERRMSG) != JIM_OK) {
	1910	return JIM_ERR;
	1911	}
	1912	if (opt < 3) {
	1913	mode = simplemodes[opt];
	1914	}
	1915	posixflags \|= modeflags[opt];
	1916	}
	1917	/* mode must be set here if it started with 'R' or 'W' and passed the enum check above */
	1918	assert(mode);
	1919	fd = open(filename, posixflags, 0666);
	1920	if (fd >= 0) {
	1921	fh = fdopen(fd, mode);
	1922	if (fh == NULL) {
	1923	close(fd);
	1924	}
	1925	}
	1926	}
	1927	else
	1928	#endif
	1929	{
	1930	fh = fopen(filename, mode);
	1931	}
	1932
	1933	if (fh == NULL) {
	1934	JimAioSetError(interp, argv[1]);
	1935	return JIM_ERR;
	1936	}
	1937
	1938	return JimMakeChannel(interp, fh, fd, argv[1], "aio.handle%ld", 0, mode, 0) ? JIM_OK : JIM_ERR;
1809	1939	}
1810	1940
1811	1941	#if defined(JIM_SSL) && !defined(JIM_BOOTSTRAP)

1841	1971	* Creates a channel for fh/fd/filename.
1842	1972	*
1843	1973	* If fh is not NULL, uses that as the channel (and sets AIO_KEEPOPEN).
1844		* Otherwise, if fd is >= 0, uses that as the channel.
1845		* Otherwise opens 'filename' with mode 'mode'.
	1974	* Otherwise fd must be >= 0, in which case it uses that as the channel.
1846	1975	*
1847	1976	* hdlfmt is a sprintf format for the filehandle. Anything with %ld at the end will do.
1848	1977	* mode is used for open or fdopen.
1849	1978	*
1850	1979	* Creates the command and sets the name as the current result.
1851		* Returns the AioFile pointer on sucess or NULL on failure.
	1980	* Returns the AioFile pointer on sucess or NULL on failure (only if fdopen fails).
1852	1981	*/
1853	1982	static AioFile JimMakeChannel(Jim_Interp interp, FILE fh, int fd, Jim_Obj filename,
1854	1983	const char hdlfmt, int family, const char mode, int flags)
1855	1984	{
1856	1985	AioFile *af;
1857	1986	char buf[AIO_CMD_LEN];
1858
1859		snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp));
1860		if (!filename) {
1861		filename = Jim_NewStringObj(interp, buf, -1);
1862		}
1863
1864		Jim_IncrRefCount(filename);
	1987	Jim_Obj *cmdname;
1865	1988
1866	1989	if (fh == NULL) {
1867		if (fd >= 0) {
	1990	assert(fd >= 0);
1868	1991	#ifndef JIM_ANSIC
1869		fh = fdopen(fd, mode);
1870		#endif
1871		}
1872		else
1873		fh = fopen(Jim_String(filename), mode);
	1992	fh = fdopen(fd, mode);
1874	1993
1875	1994	if (fh == NULL) {
1876	1995	JimAioSetError(interp, filename);
1877		#ifndef JIM_ANSIC
1878		if (fd >= 0) {
1879		close(fd);
1880		}
1881		#endif
1882		Jim_DecrRefCount(interp, filename);
	1996	close(fd);
1883	1997	return NULL;
1884	1998	}
1885		}
	1999	#endif
	2000	}
	2001
	2002	snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp));
	2003	cmdname = Jim_NewStringObj(interp, buf, -1);
	2004	if (!filename) {
	2005	filename = cmdname;
	2006	}
	2007	Jim_IncrRefCount(filename);
1886	2008
1887	2009	/* Create the file command */
1888	2010	af = Jim_Alloc(sizeof(*af));
1889	2011	memset(af, 0, sizeof(*af));
1890	2012	af->fp = fh;
1891	2013	af->filename = filename;
1892		af->openFlags = flags;
	2014	af->flags = flags;
1893	2015	#ifndef JIM_ANSIC
1894	2016	af->fd = fileno(fh);
1895	2017	#ifdef FD_CLOEXEC

1907	2029	/* Note that the command must use the global namespace, even if
1908	2030	* the current namespace is something different
1909	2031	*/
1910		Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1)));
	2032	Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, cmdname));
1911	2033
1912	2034	return af;
1913	2035	}
1914	2036
1915		#if defined(HAVE_PIPE) \|\| (defined(HAVE_SOCKETPAIR) && UNIX_SOCKETS)
	2037	#if defined(HAVE_PIPE) \|\| (defined(HAVE_SOCKETPAIR) && UNIX_SOCKETS) \|\| defined(HAVE_OPENPTY)
1916	2038	/**
1917	2039	* Create a pair of channels. e.g. from pipe() or socketpair()
1918	2040	*/

1954	2076	}
1955	2077
1956	2078	return JimMakeChannelPair(interp, p, argv[0], "aio.pipe%ld", 0, mode);
	2079	}
	2080	#endif
	2081
	2082	#ifdef HAVE_OPENPTY
	2083	static int JimAioOpenPtyCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
	2084	{
	2085	int p[2];
	2086	static const char * const mode[2] = { "r+", "w+" };
	2087
	2088	if (argc != 1) {
	2089	Jim_WrongNumArgs(interp, 1, argv, "");
	2090	return JIM_ERR;
	2091	}
	2092
	2093	if (openpty(&p[0], &p[1], NULL, NULL, NULL) != 0) {
	2094	JimAioSetError(interp, NULL);
	2095	return JIM_ERR;
	2096	}
	2097
	2098	return JimMakeChannelPair(interp, p, argv[0], "aio.pty%ld", 0, mode);
1957	2099	}
1958	2100	#endif
1959	2101

1972	2114	"stream.server",
1973	2115	"pipe",
1974	2116	"pair",
	2117	"pty",
1975	2118	NULL
1976	2119	};
1977	2120	enum

1986	2129	SOCK_STREAM_SERVER,
1987	2130	SOCK_STREAM_PIPE,
1988	2131	SOCK_STREAM_SOCKETPAIR,
	2132	SOCK_STREAM_PTY,
1989	2133	};
1990	2134	int socktype;
1991	2135	int sock;

2132	2276	family = PF_UNIX;
2133	2277	break;
2134	2278	#endif
	2279	#ifdef HAVE_OPENPTY
	2280	case SOCK_STREAM_PTY:
	2281	if (addr \|\| ipv6) {
	2282	goto wrongargs;
	2283	}
	2284	return JimAioOpenPtyCommand(interp, 1, &argv[1]);
	2285	#endif
2135	2286
2136	2287	default:
2137	2288	Jim_SetResultString(interp, "Unsupported socket type", -1);

2145	2296	return JIM_ERR;
2146	2297	}
2147	2298	if (bind_addr) {
2148		if (JimParseSocketAddress(interp, family, bind_addr, &sa, &salen) != JIM_OK) {
	2299	if (JimParseSocketAddress(interp, family, type, bind_addr, &sa, &salen) != JIM_OK) {
2149	2300	close(sock);
2150	2301	return JIM_ERR;
2151	2302	}

2159	2310	}
2160	2311	}
2161	2312	if (connect_addr) {
2162		if (JimParseSocketAddress(interp, family, connect_addr, &sa, &salen) != JIM_OK) {
	2313	if (JimParseSocketAddress(interp, family, type, connect_addr, &sa, &salen) != JIM_OK) {
2163	2314	close(sock);
2164	2315	return JIM_ERR;
2165	2316	}

-5

jim-array.c less more

113	113	return JIM_OK;
114	114	}
115	115
116		if (Jim_DictPairs(interp, objPtr, &dictValuesObj, &len) != JIM_OK) {
	116	dictValuesObj = Jim_DictPairs(interp, objPtr, &len);
	117	if (dictValuesObj == NULL) {
117	118	/* Variable is not an array - tclsh ignores this and returns nothing - be compatible */
118	119	Jim_SetResultString(interp, "", -1);
119	120	return JIM_OK;

127	128	Jim_DictAddElement(interp, resultObj, dictValuesObj[i], dictValuesObj[i + 1]);
128	129	}
129	130	}
130		Jim_Free(dictValuesObj);
131	131
132	132	Jim_SetVariable(interp, argv[0], resultObj);
133	133	return JIM_OK;

258	258
259	259	int Jim_arrayInit(Jim_Interp *interp)
260	260	{
261		if (Jim_PackageProvide(interp, "array", "1.0", JIM_ERRMSG))
262		return JIM_ERR;
263
	261	Jim_PackageProvideCheck(interp, "array");
264	262	Jim_CreateCommand(interp, "array", Jim_SubCmdProc, (void *)array_command_table, NULL);
265	263	return JIM_OK;
266	264	}

-3

jim-clock.c less more

227	227
228	228	int Jim_clockInit(Jim_Interp *interp)
229	229	{
230		if (Jim_PackageProvide(interp, "clock", "1.0", JIM_ERRMSG))
231		return JIM_ERR;
232
	230	Jim_PackageProvideCheck(interp, "clock");
233	231	Jim_CreateCommand(interp, "clock", Jim_SubCmdProc, (void *)clock_command_table, NULL);
234	232	return JIM_OK;
235	233	}

+50

-2

jim-eventloop.c less more

147	147	}
148	148
149	149
	150	/**
	151	* Register a file event handler on the given file descriptor with the given mask
	152	* (may be 1 or more of JIM_EVENT_xxx)
	153	*
	154	* When the event occurs, proc is called with clientData and the mask of events that occurred.
	155	* When the filehandler is removed, finalizerProc is called.
	156	*
	157	* Note that no check is made that only one handler is registered for the given
	158	* event(s).
	159	*/
150	160	void Jim_CreateFileHandler(Jim_Interp *interp, int fd, int mask,
151	161	Jim_FileProc * proc, void clientData, Jim_EventFinalizerProc finalizerProc)
152	162	{

161	171	fe->clientData = clientData;
162	172	fe->next = eventLoop->fileEventHead;
163	173	eventLoop->fileEventHead = fe;
	174	}
	175
	176	static int JimEventHandlerScript(Jim_Interp interp, void clientData, int mask)
	177	{
	178	return Jim_EvalObjBackground(interp, (Jim_Obj *)clientData);
	179	}
	180
	181	static void JimEventHandlerScriptFinalize(Jim_Interp interp, void clientData)
	182	{
	183	Jim_DecrRefCount(interp, (Jim_Obj *)clientData);
	184	}
	185
	186	/**
	187	* A convenience version of Jim_CreateFileHandler() which evaluates
	188	* scriptObj with Jim_EvalObjBackground() when the event occurs.
	189	*/
	190	void Jim_CreateScriptFileHandler(Jim_Interp *interp, int fd, int mask,
	191	Jim_Obj *scriptObj)
	192	{
	193	Jim_IncrRefCount(scriptObj);
	194	Jim_CreateFileHandler(interp, fd, mask, JimEventHandlerScript, scriptObj, JimEventHandlerScriptFinalize);
	195	}
	196
	197	/**
	198	* If there is a file handler registered with the given mask, return the clientData
	199	* for the (first) handler.
	200	* Otherwise return NULL.
	201	*/
	202	void Jim_FindFileHandler(Jim_Interp interp, int fd, int mask)
	203	{
	204	Jim_FileEvent *fe;
	205	Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop");
	206
	207	for (fe = eventLoop->fileEventHead; fe; fe = fe->next) {
	208	if (fe->fd == fd && (fe->mask & mask)) {
	209	return fe->clientData;
	210	}
	211	}
	212	return NULL;
164	213	}
165	214
166	215	/**

744	793	{
745	794	Jim_EventLoop *eventLoop;
746	795
747		if (Jim_PackageProvide(interp, "eventloop", "1.0", JIM_ERRMSG))
748		return JIM_ERR;
	796	Jim_PackageProvideCheck(interp, "eventloop");
749	797
750	798	eventLoop = Jim_Alloc(sizeof(*eventLoop));
751	799	memset(eventLoop, 0, sizeof(*eventLoop));

-0

jim-eventloop.h less more

63	63	int fd, int mask,
64	64	Jim_FileProc proc, void clientData,
65	65	Jim_EventFinalizerProc *finalizerProc);
	66	JIM_EXPORT void Jim_CreateScriptFileHandler(Jim_Interp *interp,
	67	int fd, int mask, Jim_Obj *scriptObj);
66	68	JIM_EXPORT void Jim_DeleteFileHandler (Jim_Interp *interp,
67	69	int fd, int mask);
68	70	JIM_EXPORT jim_wide Jim_CreateTimeHandler (Jim_Interp *interp,

70	72	Jim_TimeProc proc, void clientData,
71	73	Jim_EventFinalizerProc *finalizerProc);
72	74	JIM_EXPORT jim_wide Jim_DeleteTimeHandler (Jim_Interp *interp, jim_wide id);
	75	JIM_EXPORT void Jim_FindFileHandler(Jim_Interp interp, int fd, int mask);
73	76
74	77	#define JIM_FILE_EVENTS 1
75	78	#define JIM_TIME_EVENTS 2

-13

jim-exec.c less more

81	81
82	82	int Jim_execInit(Jim_Interp *interp)
83	83	{
84		if (Jim_PackageProvide(interp, "exec", "1.0", JIM_ERRMSG))
85		return JIM_ERR;
86
	84	Jim_PackageProvideCheck(interp, "exec");
87	85	Jim_CreateCommand(interp, "exec", Jim_ExecCmd, NULL, NULL);
88	86	return JIM_OK;
89	87	}

985	983	*/
986	984
987	985	pidPtr = Jim_Alloc(cmdCount * sizeof(*pidPtr));
988		for (i = 0; i < numPids; i++) {
989		pidPtr[i] = JIM_BAD_PID;
990		}
991	986	for (firstArg = 0; firstArg < arg_count; numPids++, firstArg = lastArg + 1) {
992	987	int pipe_dup_err = 0;
993	988	int origErrorId = errorId;

1050	1045	if (pid == 0) {
1051	1046	/* Child */
1052	1047	/* Set up stdin, stdout, stderr */
1053		if (inputId != -1) {
	1048	if (inputId != -1 && inputId != fileno(stdin)) {
1054	1049	dup2(inputId, fileno(stdin));
1055	1050	close(inputId);
1056	1051	}
1057		if (outputId != -1) {
	1052	if (outputId != -1 && outputId != fileno(stdout)) {
1058	1053	dup2(outputId, fileno(stdout));
1059	1054	if (outputId != errorId) {
1060	1055	close(outputId);
1061	1056	}
1062	1057	}
1063		if (errorId != -1) {
	1058	if (errorId != -1 && errorId != fileno(stderr)) {
1064	1059	dup2(errorId, fileno(stderr));
1065	1060	close(errorId);
1066	1061	}
1067	1062	/* Close parent-only file descriptors */
1068		if (outPipePtr) {
	1063	if (outPipePtr && *outPipePtr != -1) {
1069	1064	close(*outPipePtr);
1070	1065	}
1071		if (errFilePtr) {
	1066	if (errFilePtr && *errFilePtr != -1) {
1072	1067	close(*errFilePtr);
1073	1068	}
1074	1069	if (pipeIds[0] != -1) {

1232	1227	int Jim_execInit(Jim_Interp *interp)
1233	1228	{
1234	1229	struct WaitInfoTable *waitinfo;
1235		if (Jim_PackageProvide(interp, "exec", "1.0", JIM_ERRMSG))
1236		return JIM_ERR;
	1230
	1231	Jim_PackageProvideCheck(interp, "exec");
1237	1232
1238	1233	waitinfo = JimAllocWaitInfoTable();
1239	1234	Jim_CreateCommand(interp, "exec", Jim_ExecCmd, waitinfo, JimFreeWaitInfoTable);

+33

-30

jim-file.c less more

47	47	#include <string.h>
48	48	#include <stdio.h>
49	49	#include <errno.h>
50		#include <sys/stat.h>
51	50
52	51	#include <jimautoconf.h>
53	52	#include <jim-subcmd.h>
	53	#include <jimiocompat.h>
54	54
55	55	#ifdef HAVE_UTIMES
56	56	#include <sys/time.h>

160	160	Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, value));
161	161	}
162	162
163		static int StoreStatData(Jim_Interp interp, Jim_Obj varName, const struct stat *sb)
	163	static int StoreStatData(Jim_Interp interp, Jim_Obj varName, const jim_stat_t *sb)
164	164	{
165	165	/* Just use a list to store the data */
166	166	Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);

253	253	const char *path = Jim_String(objPtr);
254	254	const char *p = strrchr(path, '/');
255	255
256		if (!p && path[0] == '.' && path[1] == '.' && path[2] == '\0') {
257		Jim_SetResultString(interp, "..", -1);
258		} else if (!p) {
	256	if (!p) {
259	257	Jim_SetResultString(interp, ".", -1);
	258	}
	259	else if (p[1] == 0) {
	260	/* Trailing slash so do nothing */
	261	Jim_SetResult(interp, objPtr);
260	262	}
261	263	else if (p == path) {
262	264	Jim_SetResultString(interp, "/", -1);

305	307
306	308	static int file_cmd_rootname(Jim_Interp interp, int argc, Jim_Obj const *argv)
307	309	{
308		Jim_Obj *objPtr = JimStripTrailingSlashes(interp, argv[0]);
309		const char *path = Jim_String(objPtr);
	310	const char *path = Jim_String(argv[0]);
310	311	const char *lastSlash = strrchr(path, '/');
311	312	const char *p = strrchr(path, '.');
312	313
313	314	if (p == NULL \|\| (lastSlash != NULL && lastSlash > p)) {
314		Jim_SetResult(interp, objPtr);
	315	Jim_SetResult(interp, argv[0]);
315	316	}
316	317	else {
317	318	Jim_SetResultString(interp, path, p - path);
318	319	}
319		Jim_DecrRefCount(interp, objPtr);
320	320	return JIM_OK;
321	321	}
322	322

540	540	}
541	541	/* Maybe it already exists as a directory */
542	542	if (errno == EEXIST) {
543		struct stat sb;
544
545		if (stat(path, &sb) == 0 && S_ISDIR(sb.st_mode)) {
	543	jim_stat_t sb;
	544
	545	if (Jim_Stat(path, &sb) == 0 && S_ISDIR(sb.st_mode)) {
546	546	return 0;
547	547	}
548	548	/* Restore errno */

606	606	argv[1]);
607	607	return JIM_ERR;
608	608	}
609
	609	#if ISWINDOWS
	610	if (access(dest, F_OK) == 0) {
	611	/* Windows won't rename over an existing file */
	612	remove(dest);
	613	}
	614	#endif
610	615	if (rename(source, dest) != 0) {
611	616	Jim_SetResultFormatted(interp, "error renaming \"%#s\" to \"%#s\": %s", argv[0], argv[1],
612	617	strerror(errno));

654	659	}
655	660	#endif
656	661
657		static int file_stat(Jim_Interp interp, Jim_Obj filename, struct stat *sb)
	662	static int file_stat(Jim_Interp interp, Jim_Obj filename, jim_stat_t *sb)
658	663	{
659	664	const char *path = Jim_String(filename);
660	665
661		if (stat(path, sb) == -1) {
	666	if (Jim_Stat(path, sb) == -1) {
662	667	Jim_SetResultFormatted(interp, "could not read \"%#s\": %s", filename, strerror(errno));
663	668	return JIM_ERR;
664	669	}

666	671	}
667	672
668	673	#ifdef HAVE_LSTAT
669		static int file_lstat(Jim_Interp interp, Jim_Obj filename, struct stat *sb)
	674	static int file_lstat(Jim_Interp interp, Jim_Obj filename, jim_stat_t *sb)
670	675	{
671	676	const char *path = Jim_String(filename);
672	677

682	687
683	688	static int file_cmd_atime(Jim_Interp interp, int argc, Jim_Obj const *argv)
684	689	{
685		struct stat sb;
	690	jim_stat_t sb;
686	691
687	692	if (file_stat(interp, argv[0], &sb) != JIM_OK) {
688	693	return JIM_ERR;

715	720
716	721	static int file_cmd_mtime(Jim_Interp interp, int argc, Jim_Obj const *argv)
717	722	{
718		struct stat sb;
	723	jim_stat_t sb;
719	724
720	725	if (argc == 2) {
721	726	jim_wide secs;

734	739	#ifdef STAT_MTIME_US
735	740	static int file_cmd_mtimeus(Jim_Interp interp, int argc, Jim_Obj const *argv)
736	741	{
737		struct stat sb;
	742	jim_stat_t sb;
738	743
739	744	if (argc == 2) {
740	745	jim_wide us;

758	763
759	764	static int file_cmd_size(Jim_Interp interp, int argc, Jim_Obj const *argv)
760	765	{
761		struct stat sb;
	766	jim_stat_t sb;
762	767
763	768	if (file_stat(interp, argv[0], &sb) != JIM_OK) {
764	769	return JIM_ERR;

769	774
770	775	static int file_cmd_isdirectory(Jim_Interp interp, int argc, Jim_Obj const *argv)
771	776	{
772		struct stat sb;
	777	jim_stat_t sb;
773	778	int ret = 0;
774	779
775	780	if (file_stat(interp, argv[0], &sb) == JIM_OK) {

781	786
782	787	static int file_cmd_isfile(Jim_Interp interp, int argc, Jim_Obj const *argv)
783	788	{
784		struct stat sb;
	789	jim_stat_t sb;
785	790	int ret = 0;
786	791
787	792	if (file_stat(interp, argv[0], &sb) == JIM_OK) {

794	799	#ifdef HAVE_GETEUID
795	800	static int file_cmd_owned(Jim_Interp interp, int argc, Jim_Obj const *argv)
796	801	{
797		struct stat sb;
	802	jim_stat_t sb;
798	803	int ret = 0;
799	804
800	805	if (file_stat(interp, argv[0], &sb) == JIM_OK) {

815	820
816	821	if (linkLength == -1) {
817	822	Jim_Free(linkValue);
818		Jim_SetResultFormatted(interp, "couldn't readlink \"%#s\": %s", argv[0], strerror(errno));
	823	Jim_SetResultFormatted(interp, "could not read link \"%#s\": %s", argv[0], strerror(errno));
819	824	return JIM_ERR;
820	825	}
821	826	linkValue[linkLength] = 0;

826	831
827	832	static int file_cmd_type(Jim_Interp interp, int argc, Jim_Obj const *argv)
828	833	{
829		struct stat sb;
	834	jim_stat_t sb;
830	835
831	836	if (file_lstat(interp, argv[0], &sb) != JIM_OK) {
832	837	return JIM_ERR;

838	843	#ifdef HAVE_LSTAT
839	844	static int file_cmd_lstat(Jim_Interp interp, int argc, Jim_Obj const *argv)
840	845	{
841		struct stat sb;
	846	jim_stat_t sb;
842	847
843	848	if (file_lstat(interp, argv[0], &sb) != JIM_OK) {
844	849	return JIM_ERR;

851	856
852	857	static int file_cmd_stat(Jim_Interp interp, int argc, Jim_Obj const *argv)
853	858	{
854		struct stat sb;
	859	jim_stat_t sb;
855	860
856	861	if (file_stat(interp, argv[0], &sb) != JIM_OK) {
857	862	return JIM_ERR;

1113	1118
1114	1119	int Jim_fileInit(Jim_Interp *interp)
1115	1120	{
1116		if (Jim_PackageProvide(interp, "file", "1.0", JIM_ERRMSG))
1117		return JIM_ERR;
1118
	1121	Jim_PackageProvideCheck(interp, "file");
1119	1122	Jim_CreateCommand(interp, "file", Jim_SubCmdProc, (void *)file_command_table, NULL);
1120	1123	Jim_CreateCommand(interp, "pwd", Jim_PwdCmd, NULL, NULL);
1121	1124	Jim_CreateCommand(interp, "cd", Jim_CdCmd, NULL, NULL);

-1

jim-format.c less more

330	330	j = 0;
331	331	for (i = length; i > 0; ) {
332	332	i--;
333		if (w & ((unsigned jim_wide)1 << i)) {
	333	if (w & ((unsigned jim_wide)1 << i)) {
334	334	num_buffer[j++] = '1';
335	335	}
336	336	else if (j \|\| i == 0) {

+35

-15

jim-history.c less more

64	64	return JIM_OK;
65	65	}
66	66
	67	static int history_cmd_keep(Jim_Interp interp, int argc, Jim_Obj const *argv)
	68	{
	69	long len;
	70	if (argc == 1) {
	71	if (Jim_GetLong(interp, argv[0], &len) != JIM_OK) {
	72	return JIM_ERR;
	73	}
	74	Jim_HistorySetMaxLen(len);
	75	}
	76	else {
	77	Jim_SetResultInt(interp, Jim_HistoryGetMaxLen());
	78	}
	79	return JIM_OK;
	80	}
	81
67	82	static const jim_subcmd_type history_command_table[] = {
	83	{ "add",
	84	"line",
	85	history_cmd_add,
	86	1,
	87	1,
	88	/* Description: Adds the line to the history ands saves */
	89	},
	90	{ "completion",
	91	"command",
	92	history_cmd_setcompletion,
	93	1,
	94	1,
	95	/* Description: Sets an autocompletion callback command, or none if "" */
	96	},
68	97	{ "getline",
69	98	"prompt ?varname?",
70	99	history_cmd_getline,

72	101	2,
73	102	/* Description: Reads one line from the user. Similar to gets. */
74	103	},
75		{ "completion",
76		"command",
77		history_cmd_setcompletion,
	104	{ "keep",
	105	"?count?",
	106	history_cmd_keep,
	107	0,
78	108	1,
79		1,
80		/* Description: Sets an autocompletion callback command, or none if "" */
	109	/* Description: Set or display the max history length */
81	110	},
82	111	{ "load",
83	112	"filename",

93	122	1,
94	123	/* Description: Saves history to the given file */
95	124	},
96		{ "add",
97		"line",
98		history_cmd_add,
99		1,
100		1,
101		/* Description: Adds the line to the history ands saves */
102		},
103	125	{ "show",
104	126	NULL,
105	127	history_cmd_show,

112	134
113	135	int Jim_historyInit(Jim_Interp *interp)
114	136	{
115		if (Jim_PackageProvide(interp, "history", "1.0", JIM_ERRMSG))
116		return JIM_ERR;
117
	137	Jim_PackageProvideCheck(interp, "history");
118	138	Jim_CreateCommand(interp, "history", Jim_SubCmdProc, (void *)history_command_table, NULL);
119	139	return JIM_OK;
120	140	}

+19

-1

jim-interactive.c less more

106	106	#endif
107	107	}
108	108
	109	void Jim_HistorySetMaxLen(int length)
	110	{
	111	#ifdef USE_LINENOISE
	112	linenoiseHistorySetMaxLen(length);
	113	#endif
	114	}
	115
	116	int Jim_HistoryGetMaxLen(void)
	117	{
	118	#ifdef USE_LINENOISE
	119	return linenoiseHistoryGetMaxLen();
	120	#endif
	121	return 0;
	122	}
	123
109	124	#ifdef USE_LINENOISE
110	125	struct JimCompletionInfo {
111	126	Jim_Interp *interp;

260	275	}
261	276	result = Jim_GetString(Jim_GetResult(interp), &reslen);
262	277	if (reslen) {
263		printf("%s\n", result);
	278	if (fwrite(result, reslen, 1, stdout) == 0) {
	279	/* nothing */
	280	}
	281	putchar('\n');
264	282	}
265	283	}
266	284	out:

-4

jim-interp.c less more

41	41
42	42	static int interp_cmd_delete(Jim_Interp interp, int argc, Jim_Obj const *argv)
43	43	{
44		return Jim_DeleteCommand(interp, Jim_String(argv[0]));
	44	return Jim_DeleteCommand(interp, argv[0]);
45	45	}
46	46
47	47	static void JimInterpDelAlias(Jim_Interp interp, void privData)

168	168
169	169	int Jim_interpInit(Jim_Interp *interp)
170	170	{
171		if (Jim_PackageProvide(interp, "interp", "1.0", JIM_ERRMSG))
172		return JIM_ERR;
173
	171	Jim_PackageProvideCheck(interp, "interp");
174	172	Jim_CreateCommand(interp, "interp", JimInterpCommand, NULL, NULL);
175	173
176	174	return JIM_OK;

-5

jim-json.c less more

140	140	json_schema_t container_type = JSON_OBJ; /* JSON_LIST, JSON_MIXED or JSON_OBJ */
141	141
142	142	if (state->schemaObj) {
143		json_schema_t list_type;
	143	/* Don't strictly need to initialise this, but some compilers can't figure out it is always
	144	* assigned a value below.
	145	*/
	146	json_schema_t list_type = JSON_STR;
144	147	/* Figure out the type to use for the container */
145	148	if (type == JSMN_ARRAY) {
146	149	/* If every element of the array is of the same primitive schema type (str, bool or num),

414	417	int
415	418	Jim_jsonInit(Jim_Interp *interp)
416	419	{
417		if (Jim_PackageProvide(interp, "json", "1.0", JIM_ERRMSG) != JIM_OK) {
418		return JIM_ERR;
419		}
420
	420	Jim_PackageProvideCheck(interp, "json");
421	421	Jim_CreateCommand(interp, "json::decode", json_decode, NULL, NULL);
422	422	/* Load the Tcl implementation of the json encoder if possible */
423	423	Jim_PackageRequire(interp, "jsonencode", 0);

-4

jim-mk.cpp less more

1568	1568
1569	1569	static int view_cmd_destroy(Jim_Interp interp, int argc, Jim_Obj const *argv)
1570	1570	{
1571		Jim_DeleteCommand(interp, Jim_String(argv[0]));
	1571	Jim_DeleteCommand(interp, argv[0]);
1572	1572	return JIM_OK;
1573	1573	}
1574	1574

1800	1800
1801	1801	cmd = Jim_GetCommand(interp, argv[0], 0);
1802	1802	if (cmd && !cmd->isproc && cmd->u.native.cmdProc == JimOneShotViewSubCmdProc)
1803		Jim_DeleteCommand(interp, Jim_String(argv[0]));
	1803	Jim_DeleteCommand(interp, argv[0]);
1804	1804
1805	1805	return result;
1806	1806	}

1808	1808	static int JimViewFinalizerProc(Jim_Interp interp, int argc, Jim_Obj const *argv)
1809	1809	{
1810	1810	/* We won't succeed here if the user renamed the command, and this is right */
1811		Jim_DeleteCommand(interp, Jim_String(argv[1]));
	1811	Jim_DeleteCommand(interp, argv[1]);
1812	1812	return JIM_OK;
1813	1813	}
1814	1814

2037	2037
2038	2038	static int storage_cmd_close(Jim_Interp interp, int argc, Jim_Obj const *argv)
2039	2039	{
2040		return Jim_DeleteCommand(interp, Jim_String(argv[0]));
	2040	return Jim_DeleteCommand(interp, argv[0]);
2041	2041	}
2042	2042
2043	2043	/* Command table ----------------------------------------------------------- */

-3

jim-namespace.c less more

323	323
324	324	int Jim_namespaceInit(Jim_Interp *interp)
325	325	{
326		if (Jim_PackageProvide(interp, "namespace", "1.0", JIM_ERRMSG))
327		return JIM_ERR;
328
	326	Jim_PackageProvideCheck(interp, "namespace");
329	327	Jim_CreateCommand(interp, "namespace", JimNamespaceCmd, NULL, NULL);
330	328	Jim_CreateCommand(interp, "variable", JimVariableCmd, NULL, NULL);
331	329	return JIM_OK;

+20

-27

jim-pack.c less more

289	289	return JIM_ERR;
290	290	}
291	291
292		if (Jim_GetWide(interp, argv[3], &pos) != JIM_OK) {
293		return JIM_ERR;
294		}
295		if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) {
	292	if (Jim_GetWideExpr(interp, argv[3], &pos) != JIM_OK) {
	293	return JIM_ERR;
	294	}
	295	if (pos < 0 \|\| (option == OPT_STR && pos % 8)) {
	296	Jim_SetResultFormatted(interp, "bad bitoffset: %#s", argv[3]);
	297	return JIM_ERR;
	298	}
	299	if (Jim_GetWideExpr(interp, argv[4], &width) != JIM_OK) {
	300	return JIM_ERR;
	301	}
	302	if (width < 0 \|\| (option == OPT_STR && width % 8) \|\| (option != OPT_STR && width > sizeof(jim_wide) * 8) \|\|
	303	((option == OPT_FLOATLE \|\| option == OPT_FLOATBE) && width != 32 && width != 64)) {
	304	Jim_SetResultFormatted(interp, "bad bitwidth: %#s", argv[4]);
296	305	return JIM_ERR;
297	306	}
298	307

300	309	int len;
301	310	const char *str = Jim_GetString(argv[1], &len);
302	311
303		if (width % 8 \|\| pos % 8) {
304		Jim_SetResultString(interp, "string field is not on a byte boundary", -1);
305		return JIM_ERR;
306		}
307
308		if (pos >= 0 && width > 0 && pos < len * 8) {
	312	if (pos < len * 8) {
309	313	if (pos + width > len * 8) {
310	314	width = len * 8 - pos;
311	315	}

318	322	const unsigned char str = (const unsigned char )Jim_GetString(argv[1], &len);
319	323	jim_wide result = 0;
320	324
321		if (width > sizeof(jim_wide) * 8) {
322		Jim_SetResultFormatted(interp, "int field is too wide: %#s", argv[4]);
323		return JIM_ERR;
324		}
325
326		if (pos >= 0 && width > 0 && pos < len * 8) {
	325	if (pos < len * 8) {
327	326	if (pos + width > len * 8) {
328	327	width = len * 8 - pos;
329	328	}

343	342	double fresult;
344	343	if (width == 32) {
345	344	fresult = (double) JimIntToFloat(result);
346		} else if (width == 64) {
	345	} else {
347	346	fresult = JimIntToDouble(result);
348		} else {
349		Jim_SetResultFormatted(interp, "float field has bad bitwidth: %#s", argv[4]);
350		return JIM_ERR;
351	347	}
352	348	Jim_SetResult(interp, Jim_NewDoubleObj(interp, fresult));
353	349	} else {

390	386	return JIM_ERR;
391	387	}
392	388	if ((option == OPT_LE \|\| option == OPT_BE) &&
393		Jim_GetWide(interp, argv[2], &value) != JIM_OK) {
	389	Jim_GetWideExpr(interp, argv[2], &value) != JIM_OK) {
394	390	return JIM_ERR;
395	391	}
396	392	if ((option == OPT_FLOATLE \|\| option == OPT_FLOATBE) &&
397	393	Jim_GetDouble(interp, argv[2], &fvalue) != JIM_OK) {
398	394	return JIM_ERR;
399	395	}
400		if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) {
	396	if (Jim_GetWideExpr(interp, argv[4], &width) != JIM_OK) {
401	397	return JIM_ERR;
402	398	}
403	399	if (width <= 0 \|\| (option == OPT_STR && width % 8) \|\| (option != OPT_STR && width > sizeof(jim_wide) * 8) \|\|

406	402	return JIM_ERR;
407	403	}
408	404	if (argc == 6) {
409		if (Jim_GetWide(interp, argv[5], &pos) != JIM_OK) {
	405	if (Jim_GetWideExpr(interp, argv[5], &pos) != JIM_OK) {
410	406	return JIM_ERR;
411	407	}
412	408	if (pos < 0 \|\| (option == OPT_STR && pos % 8)) {

478	474
479	475	int Jim_packInit(Jim_Interp *interp)
480	476	{
481		if (Jim_PackageProvide(interp, "pack", "1.0", JIM_ERRMSG)) {
482		return JIM_ERR;
483		}
484
	477	Jim_PackageProvideCheck(interp, "pack");
485	478	Jim_CreateCommand(interp, "unpack", Jim_UnpackCmd, NULL, NULL);
486	479	Jim_CreateCommand(interp, "pack", Jim_PackCmd, NULL, NULL);
487	480	return JIM_OK;

+12

-3

jim-package.c less more

189	189	/*
190	190	*----------------------------------------------------------------------
191	191	*
192		* package list
	192	* package list\|names
193	193	*
194	194	* Returns a list of known packages
195	195	*

198	198	*
199	199	*----------------------------------------------------------------------
200	200	*/
201		static int package_cmd_list(Jim_Interp interp, int argc, Jim_Obj const *argv)
	201	static int package_cmd_names(Jim_Interp interp, int argc, Jim_Obj const *argv)
202	202	{
203	203	Jim_HashTableIterator *htiter;
204	204	Jim_HashEntry *he;

235	235	{
236	236	"list",
237	237	NULL,
238		package_cmd_list,
	238	package_cmd_names,
	239	0,
	240	0,
	241	JIM_MODFLAG_HIDDEN
	242	/* Description: Deprecated - Lists all known packages */
	243	},
	244	{
	245	"names",
	246	NULL,
	247	package_cmd_names,
239	248	0,
240	249	0,
241	250	/* Description: Lists all known packages */

-3

jim-posix.c less more

136	136
137	137	int Jim_posixInit(Jim_Interp *interp)
138	138	{
139		if (Jim_PackageProvide(interp, "posix", "1.0", JIM_ERRMSG))
140		return JIM_ERR;
141
	139	Jim_PackageProvideCheck(interp, "posix");
142	140	#ifdef HAVE_FORK
143	141	Jim_CreateCommand(interp, "os.fork", Jim_PosixForkCommand, NULL, NULL);
144	142	#endif

-3

jim-readdir.c less more

113	113
114	114	int Jim_readdirInit(Jim_Interp *interp)
115	115	{
116		if (Jim_PackageProvide(interp, "readdir", "1.0", JIM_ERRMSG))
117		return JIM_ERR;
118
	116	Jim_PackageProvideCheck(interp, "readdir");
119	117	Jim_CreateCommand(interp, "readdir", Jim_ReaddirCmd, NULL, NULL);
120	118	return JIM_OK;
121	119	}

-3

jim-readline.c less more

64	64
65	65	int Jim_readlineInit(Jim_Interp *interp)
66	66	{
67		if (Jim_PackageProvide(interp, "readline", "1.0", JIM_ERRMSG))
68		return JIM_ERR;
69
	67	Jim_PackageProvideCheck(interp, "readline");
70	68	Jim_CreateCommand(interp, "readline.readline", JimRlReadlineCommand, NULL, NULL);
71	69	Jim_CreateCommand(interp, "readline.addhistory", JimRlAddHistoryCommand, NULL, NULL);
72	70	return JIM_OK;

+170

-0

jim-redis.c less more

	0	/*
	1	* Simple redis interface
	2	*
	3	* (c) 2020 Steve Bennett <steveb@workware.net.au>
	4	*
	5	* See LICENSE for license details.
	6	*/
	7	#include <jim.h>
	8	#include <jim-eventloop.h>
	9	#include <unistd.h>
	10	#include <hiredis.h>
	11
	12	/**
	13	* Recursively decode a redis reply as Tcl data structure.
	14	*/
	15	static Jim_Obj jim_redis_get_result(Jim_Interp interp, redisReply *reply)
	16	{
	17	int i;
	18	switch (reply->type) {
	19	case REDIS_REPLY_INTEGER:
	20	return Jim_NewIntObj(interp, reply->integer);
	21	case REDIS_REPLY_STATUS:
	22	case REDIS_REPLY_ERROR:
	23	case REDIS_REPLY_STRING:
	24	return Jim_NewStringObj(interp, reply->str, reply->len);
	25	break;
	26	case REDIS_REPLY_ARRAY:
	27	{
	28	Jim_Obj *obj = Jim_NewListObj(interp, NULL, 0);
	29	for (i = 0; i < reply->elements; i++) {
	30	Jim_ListAppendElement(interp, obj, jim_redis_get_result(interp, reply->element[i]));
	31	}
	32	return obj;
	33	}
	34	case REDIS_REPLY_NIL:
	35	return Jim_NewStringObj(interp, NULL, 0);
	36	default:
	37	return Jim_NewStringObj(interp, "badtype", -1);
	38	}
	39	}
	40
	41	/**
	42	* $r readable ?script?
	43	* - set or clear a readable script
	44	* $r close
	45	* - close (delete) the handle
	46	* $r read
	47	* - synchronously read a SUBSCRIBE response (typically from within readable)
	48	* $r <redis-command> ...
	49	* - invoke the redis command and return the decoded result
	50	*/
	51	static int jim_redis_subcmd(Jim_Interp interp, int argc, Jim_Obj const *argv)
	52	{
	53	int i;
	54	redisContext *c = Jim_CmdPrivData(interp);
	55	const char **args;
	56	size_t *arglens;
	57	int ret = JIM_OK;
	58
	59	redisReply *reply;
	60
	61	if (argc < 2) {
	62	Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?");
	63	return JIM_ERR;
	64	}
	65
	66	if (Jim_CompareStringImmediate(interp, argv[1], "readable")) {
	67	/* Remove any existing handler */
	68	Jim_DeleteFileHandler(interp, c->fd, JIM_EVENT_READABLE);
	69	if (argc > 2) {
	70	Jim_CreateScriptFileHandler(interp, c->fd, JIM_EVENT_READABLE, argv[2]);
	71	}
	72	return JIM_OK;
	73	}
	74	if (Jim_CompareStringImmediate(interp, argv[1], "close")) {
	75	return Jim_DeleteCommand(interp, argv[0]);
	76	}
	77	if (Jim_CompareStringImmediate(interp, argv[1], "read")) {
	78	if (redisGetReply(c, (void **)&reply) != REDIS_OK) {
	79	reply = NULL;
	80	}
	81	}
	82	else {
	83	int nargs = argc - 1;
	84	args = Jim_Alloc(sizeof(args) nargs);
	85	arglens = Jim_Alloc(sizeof(arglens) nargs);
	86	for (i = 0; i < nargs; i++) {
	87	args[i] = Jim_String(argv[i + 1]);
	88	arglens[i] = Jim_Length(argv[i + 1]);
	89	}
	90	reply = redisCommandArgv(c, nargs, args, arglens);
	91	Jim_Free(args);
	92	Jim_Free(arglens);
	93	}
	94	/* sometimes commands return NULL */
	95	if (reply) {
	96	Jim_SetResult(interp, jim_redis_get_result(interp, reply));
	97	if (reply->type == REDIS_REPLY_ERROR) {
	98	ret = JIM_ERR;
	99	}
	100	freeReplyObject(reply);
	101	}
	102	else if (c->err) {
	103	Jim_SetResultFormatted(interp, "%#s: %s", argv[1], c->errstr);
	104	ret = JIM_ERR;
	105	}
	106	return ret;
	107	}
	108
	109	static void jim_redis_del_proc(Jim_Interp interp, void privData)
	110	{
	111	redisContext *c = privData;
	112	JIM_NOTUSED(interp);
	113	Jim_DeleteFileHandler(interp, c->fd, JIM_EVENT_READABLE);
	114	redisFree(c);
	115	}
	116
	117	/**
	118	* redis <socket-stream>
	119	*
	120	* Returns a handle that can be used to communicate with the redis
	121	* instance over the socket.
	122	* The original socket handle is closed.
	123	*/
	124	static int jim_redis_cmd(Jim_Interp interp, int argc, Jim_Obj const *argv)
	125	{
	126	redisContext *c;
	127	char buf[60];
	128	Jim_Obj *objv[2];
	129	long fd;
	130	int ret;
	131
	132	if (argc != 2) {
	133	Jim_WrongNumArgs(interp, 1, argv, "socket-stream");
	134	return JIM_ERR;
	135	}
	136
	137	/* Invoke getfd to get the file descriptor */
	138	objv[0] = argv[1];
	139	objv[1] = Jim_NewStringObj(interp, "getfd", -1);
	140	ret = Jim_EvalObjVector(interp, 2, objv);
	141	if (ret == JIM_OK) {
	142	ret = Jim_GetLong(interp, Jim_GetResult(interp), &fd) == JIM_ERR;
	143	}
	144	if (ret != JIM_OK) {
	145	Jim_SetResultFormatted(interp, "%#s: not a valid stream handle: %#s", argv[0], argv[1]);
	146	return ret;
	147	}
	148
	149	/* Note that we dup the file descriptor here so that we can close the original */
	150	fd = dup(fd);
	151	/* Can't fail */
	152	c = redisConnectFd(fd);
	153	/* Now delete the original stream */
	154	Jim_DeleteCommand(interp, argv[1]);
	155	snprintf(buf, sizeof(buf), "redis.handle%ld", Jim_GetId(interp));
	156	Jim_CreateCommand(interp, buf, jim_redis_subcmd, c, jim_redis_del_proc);
	157
	158	Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1)));
	159
	160	return JIM_OK;
	161	}
	162
	163	int
	164	Jim_redisInit(Jim_Interp *interp)
	165	{
	166	Jim_PackageProvideCheck(interp, "redis");
	167	Jim_CreateCommand(interp, "redis", jim_redis_cmd, NULL, NULL);
	168	return JIM_OK;
	169	}

+21

-12

jim-regexp.c less more

52	52	#include "jimregexp.h"
53	53	#else
54	54	#include <regex.h>
	55	#define jim_regcomp regcomp
	56	#define jim_regexec regexec
	57	#define jim_regerror regerror
	58	#define jim_regfree regfree
55	59	#endif
56	60	#include "jim.h"
57	61	#include "utf8.h"
58	62
59	63	static void FreeRegexpInternalRep(Jim_Interp interp, Jim_Obj objPtr)
60	64	{
61		regfree(objPtr->internalRep.ptrIntValue.ptr);
	65	jim_regfree(objPtr->internalRep.ptrIntValue.ptr);
62	66	Jim_Free(objPtr->internalRep.ptrIntValue.ptr);
63	67	}
64	68

93	97	pattern = Jim_String(objPtr);
94	98	compre = Jim_Alloc(sizeof(regex_t));
95	99
96		if ((ret = regcomp(compre, pattern, REG_EXTENDED \| flags)) != 0) {
	100	if ((ret = jim_regcomp(compre, pattern, REG_EXTENDED \| flags)) != 0) {
97	101	char buf[100];
98	102
99		regerror(ret, compre, buf, sizeof(buf));
	103	jim_regerror(ret, compre, buf, sizeof(buf));
100	104	Jim_SetResultFormatted(interp, "couldn't compile regular expression pattern: %s", buf);
101		regfree(compre);
	105	jim_regfree(compre);
102	106	Jim_Free(compre);
103	107	return NULL;
104	108	}

236	240	}
237	241
238	242	next_match:
239		match = regexec(regex, source_str, num_vars + 1, pmatch, eflags);
	243	match = jim_regexec(regex, source_str, num_vars + 1, pmatch, eflags);
240	244	if (match >= REG_BADPAT) {
241	245	char buf[100];
242	246
243		regerror(match, regex, buf, sizeof(buf));
	247	jim_regerror(match, regex, buf, sizeof(buf));
244	248	Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf);
245	249	result = JIM_ERR;
246	250	goto done;

456	460	n = source_len - offset;
457	461	p = source_str + offset;
458	462	do {
459		int match = regexec(regex, p, MAX_SUB_MATCHES, pmatch, regexec_flags);
	463	int match = jim_regexec(regex, p, MAX_SUB_MATCHES, pmatch, regexec_flags);
460	464
461	465	if (match >= REG_BADPAT) {
462	466	char buf[100];
463	467
464		regerror(match, regex, buf, sizeof(buf));
	468	jim_regerror(match, regex, buf, sizeof(buf));
465	469	Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf);
466	470	return JIM_ERR;
467	471	}

539	543	n--;
540	544	}
541	545
542		regexec_flags \|= REG_NOTBOL;
	546	if (pmatch[0].rm_eo == pmatch[0].rm_so) {
	547	/* The match did not advance the string, so set REG_NOTBOL to force the next match */
	548	regexec_flags = REG_NOTBOL;
	549	}
	550	else {
	551	regexec_flags = 0;
	552	}
	553
543	554	} while (n);
544	555
545	556	/*

569	580
570	581	int Jim_regexpInit(Jim_Interp *interp)
571	582	{
572		if (Jim_PackageProvide(interp, "regexp", "1.0", JIM_ERRMSG))
573		return JIM_ERR;
574
	583	Jim_PackageProvideCheck(interp, "regexp");
575	584	Jim_CreateCommand(interp, "regexp", Jim_RegexpCmd, NULL, NULL);
576	585	Jim_CreateCommand(interp, "regsub", Jim_RegsubCmd, NULL, NULL);
577	586	return JIM_OK;

+459

-165

jim-sdl.c less more

35	35	#include <stdlib.h>
36	36	#include <string.h>
37	37	#include <errno.h>
	38	#include <jimautoconf.h>
38	39	#include <SDL.h>
	40	#if SDL_MAJOR_VERSION == 2
	41	#include <SDL2_gfxPrimitives.h>
	42	#ifdef HAVE_PKG_SDL2_TTF
	43	#include <SDL_ttf.h>
	44	#endif
	45	#else
39	46	#include <SDL_gfxPrimitives.h>
	47	#endif
40	48
41	49	#include <jim.h>
42
43		#define AIO_CMD_LEN 128
	50	#include <jim-subcmd.h>
	51
	52	static int jim_sdl_initialised;
44	53
45	54	typedef struct JimSdlSurface
46	55	{
	56	#if SDL_MAJOR_VERSION == 2
	57	SDL_Window *win;
	58	SDL_Renderer *screen;
	59	SDL_Texture *texture;
	60	#ifdef HAVE_PKG_SDL2_TTF
	61	TTF_Font *font;
	62	#endif
	63	#else
47	64	SDL_Surface *screen;
	65	#endif
48	66	} JimSdlSurface;
49	67
50	68	static void JimSdlSetError(Jim_Interp *interp)

58	76
59	77	JIM_NOTUSED(interp);
60	78
	79	#if SDL_MAJOR_VERSION == 2
	80	SDL_DestroyRenderer(jss->screen);
	81	SDL_DestroyWindow(jss->win);
	82	#ifdef HAVE_PKG_SDL2_TTF
	83	if (jss->font) {
	84	TTF_CloseFont(jss->font);
	85	}
	86	#endif
	87	#else
61	88	SDL_FreeSurface(jss->screen);
	89	#endif
62	90	Jim_Free(jss);
63	91	}
	92
	93	static int JimSdlGetLongs(Jim_Interp interp, int argc, Jim_Obj const argv, long dest)
	94	{
	95	while (argc) {
	96	jim_wide w;
	97	if (Jim_GetWideExpr(interp, *argv, &w) != JIM_OK) {
	98	return JIM_ERR;
	99	}
	100	*dest++ = w;
	101	argc--;
	102	argv++;
	103	}
	104	return JIM_OK;
	105	}
	106
	107	static void JimSdlClear(JimSdlSurface *jss, int r, int g, int b, int alpha)
	108	{
	109	#if SDL_MAJOR_VERSION == 2
	110	SDL_SetRenderDrawColor(jss->screen, r, g, b, alpha);
	111	SDL_RenderClear(jss->screen);
	112	#else
	113	SDL_FillRect(jss->screen, NULL, SDL_MapRGBA(jss->screen->format, r, g, b, alpha));
	114	#endif
	115	}
	116
	117	/* Process the event loop, throwing away all events except quit.
	118	* On quit, return JIM_EXIT.
	119	* If necessary, this can be caught with catch -exit { ... }
	120	*/
	121	static int JimSdlPoll(Jim_Interp *interp)
	122	{
	123	SDL_Event e;
	124	while (SDL_PollEvent(&e)) {
	125	if (e.type == SDL_QUIT) {
	126	Jim_SetResultInt(interp, 0);
	127	return JIM_EXIT;
	128	}
	129	}
	130	return JIM_OK;
	131	}
	132
	133	static int jim_sdl_subcmd_free(Jim_Interp interp, int argc, Jim_Obj const *argv)
	134	{
	135	Jim_DeleteCommand(interp, argv[0]);
	136	return JIM_OK;
	137	}
	138
	139	/* [sdl flip] - present the current image, clear the new image, poll for events.
	140	* Returns JIM_EXIT on quit event
	141	*/
	142	static int jim_sdl_subcmd_flip(Jim_Interp interp, int argc, Jim_Obj const *argv)
	143	{
	144	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	145	#if SDL_MAJOR_VERSION == 2
	146	SDL_RenderPresent(jss->screen);
	147	#else
	148	SDL_Flip(jss->screen);
	149	#endif
	150	JimSdlClear(jss, 0, 0, 0, SDL_ALPHA_OPAQUE);
	151
	152	return JimSdlPoll(interp);
	153	}
	154
	155	/* [sdl poll ?script?] - present the current image, poll for events.
	156	* Returns JIM_EXIT on quit event or JIM_OK if all events processed.
	157	*
	158	* If the script is given, evaluates the script on each poll loop until
	159	* either quit event is received or the script returns something other than JIM_OK.
	160	*/
	161	static int jim_sdl_subcmd_poll(Jim_Interp interp, int argc, Jim_Obj const *argv)
	162	{
	163	int ret = JIM_OK;
	164	#if SDL_MAJOR_VERSION == 2
	165	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	166	SDL_RenderPresent(jss->screen);
	167	#endif
	168	while (ret == JIM_OK) {
	169	ret = JimSdlPoll(interp);
	170	if (ret != JIM_OK \|\| argc != 1) {
	171	break;
	172	}
	173	ret = Jim_EvalObj(interp, argv[0]);
	174	}
	175	return ret;
	176	}
	177
	178	static int jim_sdl_subcmd_clear(Jim_Interp interp, int argc, Jim_Obj const *argv)
	179	{
	180	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	181	long vals[4];
	182	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	183	return JIM_ERR;
	184	}
	185	if (argc == 3) {
	186	vals[3] = SDL_ALPHA_OPAQUE;
	187	}
	188	JimSdlClear(jss, vals[0], vals[1], vals[2], vals[3]);
	189	return JIM_OK;
	190	}
	191
	192	static int jim_sdl_subcmd_pixel(Jim_Interp interp, int argc, Jim_Obj const *argv)
	193	{
	194	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	195	long vals[6];
	196	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	197	return JIM_ERR;
	198	}
	199	if (argc == 5) {
	200	vals[5] = SDL_ALPHA_OPAQUE;
	201	}
	202	pixelRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5]);
	203	return JIM_OK;
	204	}
	205
	206	static int jim_sdl_subcmd_circle(Jim_Interp interp, int argc, Jim_Obj const *argv)
	207	{
	208	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	209	long vals[7];
	210	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	211	return JIM_ERR;
	212	}
	213	if (argc == 6) {
	214	vals[6] = SDL_ALPHA_OPAQUE;
	215	}
	216	circleRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6]);
	217	return JIM_OK;
	218	}
	219
	220	static int jim_sdl_subcmd_aacircle(Jim_Interp interp, int argc, Jim_Obj const *argv)
	221	{
	222	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	223	long vals[7];
	224	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	225	return JIM_ERR;
	226	}
	227	if (argc == 6) {
	228	vals[6] = SDL_ALPHA_OPAQUE;
	229	}
	230	aacircleRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6]);
	231	return JIM_OK;
	232	}
	233
	234	static int jim_sdl_subcmd_fcircle(Jim_Interp interp, int argc, Jim_Obj const *argv)
	235	{
	236	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	237	long vals[7];
	238	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	239	return JIM_ERR;
	240	}
	241	if (argc == 6) {
	242	vals[6] = SDL_ALPHA_OPAQUE;
	243	}
	244	filledCircleRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6]);
	245	return JIM_OK;
	246	}
	247
	248	static int jim_sdl_subcmd_rectangle(Jim_Interp interp, int argc, Jim_Obj const *argv)
	249	{
	250	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	251	long vals[8];
	252	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	253	return JIM_ERR;
	254	}
	255	if (argc == 7) {
	256	vals[7] = SDL_ALPHA_OPAQUE;
	257	}
	258	rectangleRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6], vals[7]);
	259	return JIM_OK;
	260	}
	261
	262	static int jim_sdl_subcmd_box(Jim_Interp interp, int argc, Jim_Obj const *argv)
	263	{
	264	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	265	long vals[8];
	266	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	267	return JIM_ERR;
	268	}
	269	if (argc == 7) {
	270	vals[7] = SDL_ALPHA_OPAQUE;
	271	}
	272	boxRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6], vals[7]);
	273	return JIM_OK;
	274	}
	275
	276	static int jim_sdl_subcmd_line(Jim_Interp interp, int argc, Jim_Obj const *argv)
	277	{
	278	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	279	long vals[8];
	280	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	281	return JIM_ERR;
	282	}
	283	if (argc == 7) {
	284	vals[7] = SDL_ALPHA_OPAQUE;
	285	}
	286	lineRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6], vals[7]);
	287	return JIM_OK;
	288	}
	289
	290	static int jim_sdl_subcmd_aaline(Jim_Interp interp, int argc, Jim_Obj const *argv)
	291	{
	292	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	293	long vals[8];
	294	if (JimSdlGetLongs(interp, argc, argv, vals) != JIM_OK) {
	295	return JIM_ERR;
	296	}
	297	if (argc == 7) {
	298	vals[7] = SDL_ALPHA_OPAQUE;
	299	}
	300	aalineRGBA(jss->screen, vals[0], vals[1], vals[2], vals[3], vals[4], vals[5], vals[6], vals[7]);
	301	return JIM_OK;
	302	}
	303
	304	#ifdef HAVE_PKG_SDL2_TTF
	305	static int jim_sdl_subcmd_font(Jim_Interp interp, int argc, Jim_Obj const *argv)
	306	{
	307	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	308	long size;
	309
	310	if (Jim_GetLong(interp, argv[1], &size) != JIM_OK) {
	311	return JIM_ERR;
	312	}
	313	if (jss->font) {
	314	TTF_CloseFont(jss->font);
	315	}
	316	else {
	317	TTF_Init();
	318	}
	319	jss->font = TTF_OpenFont(Jim_String(argv[0]), size);
	320	if (jss->font == NULL) {
	321	Jim_SetResultFormatted(interp, "Failed to load font %#s", argv[0]);
	322	return JIM_ERR;
	323	}
	324	TTF_SetFontHinting(jss->font, TTF_HINTING_LIGHT);
	325	return JIM_OK;
	326	}
	327
	328	static int jim_sdl_subcmd_text(Jim_Interp interp, int argc, Jim_Obj const *argv)
	329	{
	330	JimSdlSurface *jss = Jim_CmdPrivData(interp);
	331	long vals[6];
	332	SDL_Surface *surface;
	333	SDL_Texture *texture;
	334	SDL_Rect rect;
	335	SDL_Color col;
	336
	337	if (!jss->font) {
	338	Jim_SetResultString(interp, "No font loaded", -1);
	339	return JIM_ERR;
	340	}
	341
	342	if (JimSdlGetLongs(interp, argc - 1, argv + 1, vals) != JIM_OK) {
	343	return JIM_ERR;
	344	}
	345	col.r = vals[2];
	346	col.g = vals[3];
	347	col.b = vals[4];
	348	col.a = (argc == 7) ? vals[5] : SDL_ALPHA_OPAQUE;
	349	#ifdef JIM_UTF8
	350	surface = TTF_RenderUTF8_Blended(jss->font, Jim_String(argv[0]), col);
	351	#else
	352	surface = TTF_RenderText_Blended(jss->font, Jim_String(argv[0]), col);
	353	#endif
	354	texture = SDL_CreateTextureFromSurface(jss->screen, surface);
	355	rect.x = vals[0];
	356	rect.y = vals[1];
	357	rect.w = surface->w;
	358	rect.h = surface->h;
	359	SDL_RenderCopy(jss->screen, texture, NULL, &rect);
	360	SDL_DestroyTexture(texture);
	361	SDL_FreeSurface(surface);
	362	return JIM_OK;
	363	}
	364	#endif
	365
	366	static const jim_subcmd_type sdl_command_table[] = {
	367	{ "free",
	368	NULL,
	369	jim_sdl_subcmd_free,
	370	0,
	371	0,
	372	JIM_MODFLAG_FULLARGV,
	373	},
	374	{ "flip",
	375	NULL,
	376	jim_sdl_subcmd_flip,
	377	0,
	378	0,
	379	},
	380	{ "poll",
	381	"?script?",
	382	jim_sdl_subcmd_poll,
	383	0,
	384	1,
	385	},
	386	{ "clear",
	387	"red green blue ?alpha?",
	388	jim_sdl_subcmd_clear,
	389	3,
	390	4,
	391	},
	392	{ "pixel",
	393	"x y red green blue ?alpha?",
	394	jim_sdl_subcmd_pixel,
	395	5,
	396	6,
	397	},
	398	{ "circle",
	399	"x y radius red green blue ?alpha?",
	400	jim_sdl_subcmd_circle,
	401	6,
	402	7,
	403	},
	404	{ "aacircle",
	405	"x y radius red green blue ?alpha?",
	406	jim_sdl_subcmd_aacircle,
	407	6,
	408	7,
	409	},
	410	{ "fcircle",
	411	"x y radius red green blue ?alpha?",
	412	jim_sdl_subcmd_fcircle,
	413	6,
	414	7,
	415	},
	416	{ "rectangle",
	417	"x1 y1 x2 y2 red green blue ?alpha?",
	418	jim_sdl_subcmd_rectangle,
	419	7,
	420	8,
	421	},
	422	{ "box",
	423	"x1 y1 x2 y2 red green blue ?alpha?",
	424	jim_sdl_subcmd_box,
	425	7,
	426	8,
	427	},
	428	{ "line",
	429	"x1 y1 x2 y2 red green blue ?alpha?",
	430	jim_sdl_subcmd_line,
	431	7,
	432	8,
	433	},
	434	{ "aaline",
	435	"x1 y1 x2 y2 red green blue ?alpha?",
	436	jim_sdl_subcmd_aaline,
	437	7,
	438	8,
	439	},
	440	#ifdef HAVE_PKG_SDL2_TTF
	441	{ "font",
	442	"filename.ttf size",
	443	jim_sdl_subcmd_font,
	444	2,
	445	2,
	446	},
	447	{ "text",
	448	"x y string red green blue ?alpha?",
	449	jim_sdl_subcmd_text,
	450	6,
	451	7,
	452	},
	453	#endif
	454	{ NULL }
	455	};
64	456
65	457	/* Calls to commands created via [sdl.surface] are implemented by this
66	458	* C command. */
67	459	static int JimSdlHandlerCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
68	460	{
69		JimSdlSurface *jss = Jim_CmdPrivData(interp);
70		int option;
71		static const char * const options[] = {
72		"free", "flip", "pixel", "rectangle", "box", "line", "aaline",
73		"circle", "aacircle", "fcircle", NULL
74		};
75		enum
76		{ OPT_FREE, OPT_FLIP, OPT_PIXEL, OPT_RECTANGLE, OPT_BOX, OPT_LINE,
77		OPT_AALINE, OPT_CIRCLE, OPT_AACIRCLE, OPT_FCIRCLE
78		};
79
80		if (argc < 2) {
81		Jim_WrongNumArgs(interp, 1, argv, "method ?args ...?");
82		return JIM_ERR;
83		}
84		if (Jim_GetEnum(interp, argv[1], options, &option, "SDL surface method", JIM_ERRMSG) != JIM_OK)
85		return JIM_ERR;
86		if (option == OPT_PIXEL) {
87		/* PIXEL */
88		long x, y, red, green, blue, alpha = 255;
89
90		if (argc != 7 && argc != 8) {
91		Jim_WrongNumArgs(interp, 2, argv, "x y red green blue ?alpha?");
	461	const jim_subcmd_type *ct = Jim_ParseSubCmd(interp, sdl_command_table, argc, argv);
	462
	463	return Jim_CallSubCmd(interp, ct, argc, argv);
	464	}
	465
	466	static int JimSdlSurfaceCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
	467	{
	468	JimSdlSurface *jss;
	469	char buf[128];
	470	long vals[2];
	471	const char *title;
	472
	473	if (argc != 3 && argc != 4) {
	474	Jim_WrongNumArgs(interp, 1, argv, "xres yres ?title?");
	475	return JIM_ERR;
	476	}
	477
	478	if (JimSdlGetLongs(interp, 2, argv + 1, vals) != JIM_OK) {
	479	return JIM_ERR;
	480	}
	481
	482	if (!jim_sdl_initialised) {
	483	jim_sdl_initialised++;
	484	if (SDL_Init(SDL_INIT_VIDEO) < 0) {
	485	JimSdlSetError(interp);
92	486	return JIM_ERR;
93	487	}
94		if (Jim_GetLong(interp, argv[2], &x) != JIM_OK \|\|
95		Jim_GetLong(interp, argv[3], &y) != JIM_OK \|\|
96		Jim_GetLong(interp, argv[4], &red) != JIM_OK \|\|
97		Jim_GetLong(interp, argv[5], &green) != JIM_OK \|\|
98		Jim_GetLong(interp, argv[6], &blue) != JIM_OK) {
99		return JIM_ERR;
	488	#if SDL_MAJOR_VERSION == 2
	489	SDL_SetHint(SDL_HINT_RENDER_VSYNC, "1");
	490	SDL_SetHint(SDL_HINT_RENDER_SCALE_QUALITY, "1");
	491	#endif
	492	atexit(SDL_Quit);
	493	}
	494
	495	title = (argc == 4) ? Jim_String(argv[3]) : "sdl";
	496
	497	jss = Jim_Alloc(sizeof(*jss));
	498	memset(jss, 0, sizeof(*jss));
	499
	500	#if SDL_MAJOR_VERSION == 2
	501	/* Try to create the surface */
	502	jss->win = SDL_CreateWindow(title, SDL_WINDOWPOS_UNDEFINED, SDL_WINDOWPOS_UNDEFINED, vals[0], vals[1], 0);
	503	if (jss->win) {
	504	jss->screen = SDL_CreateRenderer(jss->win, -1, SDL_RENDERER_PRESENTVSYNC \| SDL_RENDERER_ACCELERATED);
	505	if (jss->screen) {
	506	/* Need an initial SDL_PollEvent() to make the window display */
	507	SDL_PollEvent(NULL);
100	508	}
101		if (argc == 8 && Jim_GetLong(interp, argv[7], &alpha) != JIM_OK)
102		return JIM_ERR;
103		pixelRGBA(jss->screen, x, y, red, green, blue, alpha);
104		return JIM_OK;
105		}
106		else if (option == OPT_RECTANGLE \|\| option == OPT_BOX \|\|
107		option == OPT_LINE \|\| option == OPT_AALINE) {
108		/* RECTANGLE, BOX, LINE, AALINE */
109		long x1, y1, x2, y2, red, green, blue, alpha = 255;
110
111		if (argc != 9 && argc != 10) {
112		Jim_WrongNumArgs(interp, 2, argv, "x y red green blue ?alpha?");
113		return JIM_ERR;
	509	else {
	510	SDL_DestroyWindow(jss->win);
114	511	}
115		if (Jim_GetLong(interp, argv[2], &x1) != JIM_OK \|\|
116		Jim_GetLong(interp, argv[3], &y1) != JIM_OK \|\|
117		Jim_GetLong(interp, argv[4], &x2) != JIM_OK \|\|
118		Jim_GetLong(interp, argv[5], &y2) != JIM_OK \|\|
119		Jim_GetLong(interp, argv[6], &red) != JIM_OK \|\|
120		Jim_GetLong(interp, argv[7], &green) != JIM_OK \|\|
121		Jim_GetLong(interp, argv[8], &blue) != JIM_OK) {
122		return JIM_ERR;
123		}
124		if (argc == 10 && Jim_GetLong(interp, argv[9], &alpha) != JIM_OK)
125		return JIM_ERR;
126		switch (option) {
127		case OPT_RECTANGLE:
128		rectangleRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha);
129		break;
130		case OPT_BOX:
131		boxRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha);
132		break;
133		case OPT_LINE:
134		lineRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha);
135		break;
136		case OPT_AALINE:
137		aalineRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha);
138		break;
139		}
140		return JIM_OK;
141		}
142		else if (option == OPT_CIRCLE \|\| option == OPT_AACIRCLE \|\| option == OPT_FCIRCLE) {
143		/* CIRCLE, AACIRCLE, FCIRCLE */
144		long x, y, radius, red, green, blue, alpha = 255;
145
146		if (argc != 8 && argc != 9) {
147		Jim_WrongNumArgs(interp, 2, argv, "x y radius red green blue ?alpha?");
148		return JIM_ERR;
149		}
150		if (Jim_GetLong(interp, argv[2], &x) != JIM_OK \|\|
151		Jim_GetLong(interp, argv[3], &y) != JIM_OK \|\|
152		Jim_GetLong(interp, argv[4], &radius) != JIM_OK \|\|
153		Jim_GetLong(interp, argv[5], &red) != JIM_OK \|\|
154		Jim_GetLong(interp, argv[6], &green) != JIM_OK \|\|
155		Jim_GetLong(interp, argv[7], &blue) != JIM_OK) {
156		return JIM_ERR;
157		}
158		if (argc == 9 && Jim_GetLong(interp, argv[8], &alpha) != JIM_OK)
159		return JIM_ERR;
160		switch (option) {
161		case OPT_CIRCLE:
162		circleRGBA(jss->screen, x, y, radius, red, green, blue, alpha);
163		break;
164		case OPT_AACIRCLE:
165		aacircleRGBA(jss->screen, x, y, radius, red, green, blue, alpha);
166		break;
167		case OPT_FCIRCLE:
168		filledCircleRGBA(jss->screen, x, y, radius, red, green, blue, alpha);
169		break;
170		}
171		return JIM_OK;
172		}
173		else if (option == OPT_FREE) {
174		/* FREE */
175		if (argc != 2) {
176		Jim_WrongNumArgs(interp, 2, argv, "");
177		return JIM_ERR;
178		}
179		Jim_DeleteCommand(interp, Jim_String(argv[0]));
180		return JIM_OK;
181		}
182		else if (option == OPT_FLIP) {
183		/* FLIP */
184		if (argc != 2) {
185		Jim_WrongNumArgs(interp, 2, argv, "");
186		return JIM_ERR;
187		}
188		SDL_Flip(jss->screen);
189		return JIM_OK;
190		}
191		return JIM_OK;
192		}
193
194		static int JimSdlSurfaceCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
195		{
196		JimSdlSurface *jss;
197		char buf[AIO_CMD_LEN];
198		Jim_Obj *objPtr;
199		long screenId, xres, yres;
200		SDL_Surface *screen;
201
202		if (argc != 3) {
203		Jim_WrongNumArgs(interp, 1, argv, "xres yres");
204		return JIM_ERR;
205		}
206		if (Jim_GetLong(interp, argv[1], &xres) != JIM_OK \|\|
207		Jim_GetLong(interp, argv[2], &yres) != JIM_OK)
208		return JIM_ERR;
209
210		/* Try to create the surface */
211		screen = SDL_SetVideoMode(xres, yres, 32, SDL_SWSURFACE \| SDL_ANYFORMAT);
212		if (screen == NULL) {
	512	}
	513	#else
	514	jss->screen = SDL_SetVideoMode(vals[0], vals[1], 32, SDL_SWSURFACE \| SDL_ANYFORMAT);
	515	if (jss->screen) {
	516	SDL_WM_SetCaption(title, title);
	517	}
	518	#endif
	519	if (jss->screen) {
	520	JimSdlClear(jss, 0, 0, 0, SDL_ALPHA_OPAQUE);
	521	}
	522	else {
213	523	JimSdlSetError(interp);
214		return JIM_ERR;
215		}
216		/* Get the next file id */
217		if (Jim_EvalGlobal(interp, "if {[catch {incr sdl.surfaceId}]} {set sdl.surfaceId 0}") != JIM_OK)
218		return JIM_ERR;
219		objPtr = Jim_GetVariableStr(interp, "sdl.surfaceId", JIM_ERRMSG);
220		if (objPtr == NULL)
221		return JIM_ERR;
222		if (Jim_GetLong(interp, objPtr, &screenId) != JIM_OK)
223		return JIM_ERR;
224
225		/* Create the SDL screen command */
226		jss = Jim_Alloc(sizeof(*jss));
227		jss->screen = screen;
228		sprintf(buf, "sdl.surface%ld", screenId);
	524	Jim_Free(jss);
	525	return JIM_ERR;
	526	}
	527
	528	/* Create the SDL command */
	529	snprintf(buf, sizeof(buf), "sdl.surface%ld", Jim_GetId(interp));
229	530	Jim_CreateCommand(interp, buf, JimSdlHandlerCommand, jss, JimSdlDelProc);
230	531	Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1)));
231	532	return JIM_OK;

233	534
234	535	int Jim_sdlInit(Jim_Interp *interp)
235	536	{
236		if (Jim_PackageProvide(interp, "sdl", "1.0", JIM_ERRMSG))
237		return JIM_ERR;
238
239		if (SDL_Init(SDL_INIT_VIDEO) < 0) {
240		JimSdlSetError(interp);
241		return JIM_ERR;
242		}
243		atexit(SDL_Quit);
	537	Jim_PackageProvideCheck(interp, "sdl");
244	538	Jim_CreateCommand(interp, "sdl.screen", JimSdlSurfaceCommand, NULL, NULL);
245	539	return JIM_OK;
246	540	}

-4

jim-signal.c less more

292	292	int sig = find_signal_by_name(interp, Jim_String(argv[i]));
293	293
294	294	if (sig < 0 \|\| sig >= MAX_SIGNALS) {
295		return -1;
	295	return JIM_ERR;
296	296	}
297	297	mask \|= sig_to_bit(sig);
298	298	}

529	529
530	530	int Jim_signalInit(Jim_Interp *interp)
531	531	{
532		if (Jim_PackageProvide(interp, "signal", "1.0", JIM_ERRMSG))
533		return JIM_ERR;
534
	532	Jim_PackageProvideCheck(interp, "signal");
535	533	Jim_CreateCommand(interp, "alarm", Jim_AlarmCmd, 0, 0);
536	534	Jim_CreateCommand(interp, "kill", Jim_KillCmd, 0, 0);
537	535	/* Sleep is slightly dubious here */

-5

jim-sqlite3.c less more

154	154	Jim_WrongNumArgs(interp, 2, argv, "");
155	155	return JIM_ERR;
156	156	}
157		Jim_DeleteCommand(interp, Jim_String(argv[0]));
	157	Jim_DeleteCommand(interp, argv[0]);
158	158	return JIM_OK;
159	159	}
160	160	else if (option == OPT_QUERY) {

211	211	vObj = nullStrObj;
212	212	break;
213	213	case SQLITE_INTEGER:
214		vObj = Jim_NewIntObj(interp, sqlite3_column_int(stmt, i));
	214	vObj = Jim_NewIntObj(interp, sqlite3_column_int64(stmt, i));
215	215	break;
216	216	case SQLITE_FLOAT:
217	217	vObj = Jim_NewDoubleObj(interp, sqlite3_column_double(stmt, i));

287	287
288	288	int Jim_sqlite3Init(Jim_Interp *interp)
289	289	{
290		if (Jim_PackageProvide(interp, "sqlite3", "1.0", JIM_ERRMSG))
291		return JIM_ERR;
292
	290	Jim_PackageProvideCheck(interp, "sqlite3");
293	291	Jim_CreateCommand(interp, "sqlite3.open", JimSqliteOpenCommand, NULL, NULL);
294	292	return JIM_OK;
295	293	}

+31

-14

jim-subcmd.c less more

25	25	"dummy", NULL, subcmd_null, 0, 0, JIM_MODFLAG_HIDDEN
26	26	};
27	27
28		static void add_commands(Jim_Interp interp, const jim_subcmd_type ct, const char *sep)
29		{
30		const char *s = "";
	28	/* Creates and returns a string (object) of each non-hidden command in 'ct',
	29	* sorted and separated with the given separator string.
	30	*
	31	* For example, if there are two commands, "def" and "abc", with a separator of "; ",
	32	* the returned string will be "abc; def"
	33	*
	34	* The returned object has a reference count of 0.
	35	*/
	36	static Jim_Obj subcmd_cmd_list(Jim_Interp interp, const jim_subcmd_type * ct, const char *sep)
	37	{
	38	/* Create a list to sort before joining */
	39	Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
	40	Jim_Obj *sortCmd[2];
31	41
32	42	for (; ct->cmd; ct++) {
33	43	if (!(ct->flags & JIM_MODFLAG_HIDDEN)) {
34		Jim_AppendStrings(interp, Jim_GetResult(interp), s, ct->cmd, NULL);
35		s = sep;
36		}
37		}
	44	Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, ct->cmd, -1));
	45	}
	46	}
	47
	48	/* There is no direct API to sort a list, so just invoke lsort here. */
	49	sortCmd[0] = Jim_NewStringObj(interp, "lsort", -1);
	50	sortCmd[1] = listObj;
	51	/* Leaves the result in the interpreter result */
	52	if (Jim_EvalObjVector(interp, 2, sortCmd) == JIM_OK) {
	53	return Jim_ListJoin(interp, Jim_GetResult(interp), sep, strlen(sep));
	54	}
	55	/* lsort can't really fail (normally), but if it does, just return the error as the result */
	56	return Jim_GetResult(interp);
38	57	}
39	58
40	59	static void bad_subcmd(Jim_Interp interp, const jim_subcmd_type command_table, const char *type,
41	60	Jim_Obj cmd, Jim_Obj subcmd)
42	61	{
43		Jim_SetResultFormatted(interp, "%#s, %s command \"%#s\": should be ", cmd, type, subcmd);
44		add_commands(interp, command_table, ", ");
	62	Jim_SetResultFormatted(interp, "%#s, %s command \"%#s\": should be %#s", cmd, type,
	63	subcmd, subcmd_cmd_list(interp, command_table, ", "));
45	64	}
46	65
47	66	static void show_cmd_usage(Jim_Interp interp, const jim_subcmd_type command_table, int argc,
48	67	Jim_Obj const argv)
49	68	{
50		Jim_SetResultFormatted(interp, "Usage: \"%#s command ... \", where command is one of: ", argv[0]);
51		add_commands(interp, command_table, ", ");
	69	Jim_SetResultFormatted(interp, "Usage: \"%#s command ... \", where command is one of: %#s",
	70	argv[0], subcmd_cmd_list(interp, command_table, ", "));
52	71	}
53	72
54	73	static void add_cmd_usage(Jim_Interp interp, const jim_subcmd_type ct, Jim_Obj *cmd)

122	141
123	142	/* Check for special builtin '-commands' command first */
124	143	if (Jim_CompareStringImmediate(interp, cmd, "-commands")) {
125		/* Build the result here */
126		Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
127		add_commands(interp, command_table, " ");
	144	Jim_SetResult(interp, subcmd_cmd_list(interp, command_table, " "));
128	145	return &dummy_subcmd;
129	146	}
130	147

-2

jim-syslog.c less more

171	171	{
172	172	SyslogInfo *info;
173	173
174		if (Jim_PackageProvide(interp, "syslog", "1.0", JIM_ERRMSG))
175		return JIM_ERR;
	174	Jim_PackageProvideCheck(interp, "syslog");
176	175
177	176	info = Jim_Alloc(sizeof(*info));
178	177

+29

-6

jim-tclprefix.c less more

25	25	maxlen++;
26	26	}
27	27	return maxlen;
	28	}
	29
	30	/*
	31	* Like Jim_StringCompareObj() except only matches as much as the length of firstObjPtr.
	32	* So "abc" matches "abcdef" but "abcdef" does not match "abc".
	33	*/
	34	int JimStringComparePrefix(Jim_Interp interp, Jim_Obj firstObjPtr, Jim_Obj *secondObjPtr)
	35	{
	36	/* We do this the easy way by creating a (possibly) shorter version of secondObjPtr */
	37	int l1 = Jim_Utf8Length(interp, firstObjPtr);
	38	const char *s2 = Jim_String(secondObjPtr);
	39	int l2 = Jim_Utf8Length(interp, secondObjPtr);
	40	Jim_Obj *objPtr;
	41	int ret;
	42
	43	if (l2 > l1) {
	44	objPtr = Jim_NewStringObjUtf8(interp, s2, l1);
	45	}
	46	else {
	47	objPtr = secondObjPtr;
	48	}
	49	Jim_IncrRefCount(objPtr);
	50
	51	ret = Jim_StringCompareObj(interp, firstObjPtr, objPtr, 0);
	52	Jim_DecrRefCount(interp, objPtr);
	53	return ret;
28	54	}
29	55
30	56	/* [tcl::prefix]

139	165	objPtr = Jim_NewListObj(interp, NULL, 0);
140	166	for (i = 0; i < listlen; i++) {
141	167	Jim_Obj *valObj = Jim_ListGetIndex(interp, argv[2], i);
142		if (Jim_StringCompareLenObj(interp, argv[3], valObj, 0) == 0) {
	168	if (JimStringComparePrefix(interp, argv[3], valObj) == 0) {
143	169	Jim_ListAppendElement(interp, objPtr, valObj);
144	170	}
145	171	}

163	189	for (i = 0; i < listlen; i++) {
164	190	Jim_Obj *valObj = Jim_ListGetIndex(interp, argv[2], i);
165	191
166		if (Jim_StringCompareLenObj(interp, stringObj, valObj, 0)) {
	192	if (JimStringComparePrefix(interp, stringObj, valObj)) {
167	193	/* Does not begin with 'string' */
168	194	continue;
169	195	}

187	213
188	214	int Jim_tclprefixInit(Jim_Interp *interp)
189	215	{
190		if (Jim_PackageProvide(interp, "tclprefix", "1.0", JIM_ERRMSG)) {
191		return JIM_ERR;
192		}
193
	216	Jim_PackageProvideCheck(interp, "tclprefix");
194	217	Jim_CreateCommand(interp, "tcl::prefix", Jim_TclPrefixCoreCommand, NULL, NULL);
195	218	return JIM_OK;
196	219	}

-2

jim-win32.c less more

505	505	int
506	506	Jim_win32Init(Jim_Interp *interp)
507	507	{
508		if (Jim_PackageProvide(interp, "win32", "1.0", JIM_ERRMSG))
509		return JIM_ERR;
	508	Jim_PackageProvideCheck(interp, "win32");
510	509
511	510	#define CMD(name) \
512	511	Jim_CreateCommand(interp, "win32." #name , Win32_ ## name , NULL, NULL)

-4

jim-zlib.c less more

308	308
309	309	int Jim_zlibInit(Jim_Interp *interp)
310	310	{
311		if (Jim_PackageProvide(interp, "zlib", "1.0", JIM_ERRMSG)) {
312		return JIM_ERR;
313		}
314
	311	Jim_PackageProvideCheck(interp, "zlib");
315	312	Jim_CreateCommand(interp, "zlib", JimZlibCmd, 0, 0);
316	313
317	314	return JIM_OK;

+1882

-1046

jim.c less more

63	63	#ifdef HAVE_SYS_TIME_H
64	64	#include <sys/time.h>
65	65	#endif
66		#ifdef HAVE_BACKTRACE
	66	#ifdef HAVE_EXECINFO_H
67	67	#include <execinfo.h>
68	68	#endif
69	69	#ifdef HAVE_CRT_EXTERNS_H

118	118	#endif
119	119
120	120	#ifdef JIM_OPTIMIZATION
	121	static int JimIsWide(Jim_Obj *objPtr);
121	122	#define JIM_IF_OPTIM(X) X
122	123	#else
123	124	#define JIM_IF_OPTIM(X)

137	138	static void JimFreeCallFrame(Jim_Interp interp, Jim_CallFrame cf, int action);
138	139	static int ListSetIndex(Jim_Interp interp, Jim_Obj listPtr, int listindex, Jim_Obj *newObjPtr,
139	140	int flags);
	141	static int Jim_ListIndices(Jim_Interp interp, Jim_Obj listPtr, Jim_Obj const indexv, int indexc,
	142	Jim_Obj **resultObj, int flags);
140	143	static int JimDeleteLocalProcs(Jim_Interp interp, Jim_Stack localCommands);
141	144	static Jim_Obj JimExpandDictSugar(Jim_Interp interp, Jim_Obj *objPtr);
142	145	static void SetDictSubstFromAny(Jim_Interp interp, Jim_Obj objPtr);
143		static Jim_Obj *JimDictPairs(Jim_Obj dictPtr, int *len);
144	146	static void JimSetFailedEnumResult(Jim_Interp interp, const char arg, const char *badtype,
145	147	const char prefix, const char const tablePtr, const char name);
146	148	static int JimCallProcedure(Jim_Interp interp, Jim_Cmd cmd, int argc, Jim_Obj const argv);
147	149	static int JimGetWideNoErr(Jim_Interp interp, Jim_Obj objPtr, jim_wide * widePtr);
148	150	static int JimSign(jim_wide w);
149		static int JimValidName(Jim_Interp interp, const char type, Jim_Obj *nameObjPtr);
150	151	static void JimPrngSeed(Jim_Interp interp, unsigned char seed, int seedLen);
151	152	static void JimRandomBytes(Jim_Interp interp, void dest, unsigned int len);
152
	153	static int JimSetNewVariable(Jim_HashTable ht, Jim_Obj nameObjPtr, Jim_Var *var);
	154	static Jim_Var JimFindVariable(Jim_HashTable ht, Jim_Obj *nameObjPtr);
153	155
154	156	/* Fast access to the int (wide) value of an object which is known to be of int type */
155	157	#define JimWideValue(objPtr) (objPtr)->internalRep.wideValue

185	187	*
186	188	* Returns NULL on no match.
187	189	*/
188		static const char JimCharsetMatch(const char pattern, int c, int flags)
	190	static const char JimCharsetMatch(const char pattern, int plen, int c, int flags)
189	191	{
190	192	int not = 0;
191	193	int pchar;
192	194	int match = 0;
193	195	int nocase = 0;
	196	int n;
194	197
195	198	if (flags & JIM_NOCASE) {
196	199	nocase++;

201	204	if (*pattern == '^') {
202	205	not++;
203	206	pattern++;
	207	plen--;
204	208	}
205	209
206	210	/* Special case. If the first char is ']', it is part of the set */

209	213	}
210	214	}
211	215
212		while (pattern && pattern != ']') {
	216	while (plen && *pattern != ']') {
213	217	/* Exact match */
214	218	if (pattern[0] == '\\') {
215	219	first:
216		pattern += utf8_tounicode_case(pattern, &pchar, nocase);
	220	n = utf8_tounicode_case(pattern, &pchar, nocase);
	221	pattern += n;
	222	plen -= n;
217	223	}
218	224	else {
219	225	/* Is this a range? a-z */
220	226	int start;
221	227	int end;
222	228
223		pattern += utf8_tounicode_case(pattern, &start, nocase);
224		if (pattern[0] == '-' && pattern[1]) {
	229	n = utf8_tounicode_case(pattern, &start, nocase);
	230	pattern += n;
	231	plen -= n;
	232	if (pattern[0] == '-' && plen > 1) {
225	233	/* skip '-' */
226		pattern++;
227		pattern += utf8_tounicode_case(pattern, &end, nocase);
	234	n = 1 + utf8_tounicode_case(pattern + 1, &end, nocase);
	235	pattern += n;
	236	plen -= n;
228	237
229	238	/* Handle reversed range too */
230	239	if ((c >= start && c <= end) \|\| (c >= end && c <= start)) {

250	259
251	260	/* Note: string must be valid UTF-8 sequences
252	261	*/
253		static int JimGlobMatch(const char pattern, const char string, int nocase)
	262	static int JimGlobMatch(const char pattern, int plen, const char string, int slen, int nocase)
254	263	{
255	264	int c;
256	265	int pchar;
257		while (*pattern) {
	266	int n;
	267	const char *p;
	268	while (plen) {
258	269	switch (pattern[0]) {
259	270	case '*':
260		while (pattern[1] == '*') {
	271	while (pattern[1] == '*' && plen) {
261	272	pattern++;
	273	plen--;
262	274	}
263	275	pattern++;
264		if (!pattern[0]) {
	276	plen--;
	277	if (!plen) {
265	278	return 1; /* match */
266	279	}
267		while (*string) {
	280	while (slen) {
268	281	/* Recursive call - Does the remaining pattern match anywhere? */
269		if (JimGlobMatch(pattern, string, nocase))
	282	if (JimGlobMatch(pattern, plen, string, slen, nocase))
270	283	return 1; /* match */
271		string += utf8_tounicode(string, &c);
	284	n = utf8_tounicode(string, &c);
	285	string += n;
	286	slen -= n;
272	287	}
273	288	return 0; /* no match */
274	289
275	290	case '?':
276		string += utf8_tounicode(string, &c);
	291	n = utf8_tounicode(string, &c);
	292	string += n;
	293	slen -= n;
277	294	break;
278	295
279	296	case '[': {
280		string += utf8_tounicode(string, &c);
281		pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0);
282		if (!pattern) {
	297	n = utf8_tounicode(string, &c);
	298	string += n;
	299	slen -= n;
	300	p = JimCharsetMatch(pattern + 1, plen - 1, c, nocase ? JIM_NOCASE : 0);
	301	if (!p) {
283	302	return 0;
284	303	}
285		if (!*pattern) {
	304	plen -= p - pattern;
	305	pattern = p;
	306
	307	if (!plen) {
286	308	/* Ran out of pattern (no ']') */
287	309	continue;
288	310	}

291	313	case '\\':
292	314	if (pattern[1]) {
293	315	pattern++;
	316	plen--;
294	317	}
295	318	/* fall through */
296	319	default:
297		string += utf8_tounicode_case(string, &c, nocase);
	320	n = utf8_tounicode_case(string, &c, nocase);
	321	string += n;
	322	slen -= n;
298	323	utf8_tounicode_case(pattern, &pchar, nocase);
299	324	if (pchar != c) {
300	325	return 0;
301	326	}
302	327	break;
303	328	}
304		pattern += utf8_tounicode_case(pattern, &pchar, nocase);
305		if (!*string) {
306		while (pattern == '') {
	329	n = utf8_tounicode_case(pattern, &pchar, nocase);
	330	pattern += n;
	331	plen -= n;
	332	if (!slen) {
	333	while (pattern == '' && plen) {
307	334	pattern++;
	335	plen--;
308	336	}
309	337	break;
310	338	}
311	339	}
312		if (!pattern && !string) {
	340	if (!plen && !slen) {
313	341	return 1;
314	342	}
315	343	return 0;
316	344	}
317	345
318	346	/**
319		* string comparison. Works on binary data.
	347	* utf-8 string comparison. case-insensitive if nocase is set.
320	348	*
321	349	* Returns -1, 0 or 1
322	350	*
323		* Note that the lengths are byte lengths, not char lengths.
	351	* Note that the lengths are character lengths, not byte lengths.
324	352	*/
325		static int JimStringCompare(const char s1, int l1, const char s2, int l2)
326		{
327		if (l1 < l2) {
328		return memcmp(s1, s2, l1) <= 0 ? -1 : 1;
329		}
330		else if (l2 < l1) {
331		return memcmp(s1, s2, l2) >= 0 ? 1 : -1;
332		}
333		else {
334		return JimSign(memcmp(s1, s2, l1));
335		}
336		}
337
338		/**
339		* Compare null terminated strings, up to a maximum of 'maxchars' characters,
340		* (or end of string if 'maxchars' is -1).
341		*
342		* Returns -1, 0, 1 for s1 < s2, s1 == s2, s1 > s2 respectively.
343		*
344		* Note: does not support embedded nulls.
345		*/
346		static int JimStringCompareLen(const char s1, const char s2, int maxchars, int nocase)
347		{
348		while (s1 && s2 && maxchars) {
	353	static int JimStringCompareUtf8(const char s1, int l1, const char s2, int l2, int nocase)
	354	{
	355	int minlen = l1;
	356	if (l2 < l1) {
	357	minlen = l2;
	358	}
	359	while (minlen) {
349	360	int c1, c2;
350	361	s1 += utf8_tounicode_case(s1, &c1, nocase);
351	362	s2 += utf8_tounicode_case(s2, &c2, nocase);
352	363	if (c1 != c2) {
353	364	return JimSign(c1 - c2);
354	365	}
355		maxchars--;
356		}
357		if (!maxchars) {
358		return 0;
359		}
360		/* One string or both terminated */
361		if (*s1) {
	366	minlen--;
	367	}
	368	/* Equal to this point, so the shorter string is less */
	369	if (l1 < l2) {
	370	return -1;
	371	}
	372	if (l1 > l2) {
362	373	return 1;
363		}
364		if (*s2) {
365		return -1;
366	374	}
367	375	return 0;
368	376	}

458	466	}
459	467
460	468	/* Parses the front of a number to determine its sign and base.
461		* Returns the index to start parsing according to the given base
	469	* Returns the index to start parsing according to the given base.
	470	* Sets base to zero if str contains no indicator of its base and
	471	* to the base (2, 8, 10 or 16) otherwise.
462	472	*/
463	473	static int JimNumberBase(const char str, int base, int *sign)
464	474	{
465	475	int i = 0;
466	476
467		*base = 10;
	477	*base = 0;
468	478
469	479	while (isspace(UCHAR(str[i]))) {
470	480	i++;

482	492	}
483	493
484	494	if (str[i] != '0') {
485		/* base 10 */
	495	/* no base indicator */
486	496	return 0;
487	497	}
488	498

491	501	case 'x': case 'X': *base = 16; break;
492	502	case 'o': case 'O': *base = 8; break;
493	503	case 'b': case 'B': *base = 2; break;
	504	case 'd': case 'D': *base = 10; break;
494	505	default: return 0;
495	506	}
496	507	i += 2;

499	510	/* Parse according to this base */
500	511	return i;
501	512	}
502		/* Parse as base 10 */
503		*base = 10;
	513	/* Parse as default */
	514	*base = 0;
504	515	return 0;
505	516	}
506	517

513	524	int base;
514	525	int i = JimNumberBase(str, &base, &sign);
515	526
516		if (base != 10) {
	527	if (base != 0) {
517	528	long value = strtol(str + i, endptr, base);
518	529	if (endptr == NULL \|\| *endptr != str + i) {
519	530	return value * sign;

535	546	int base;
536	547	int i = JimNumberBase(str, &base, &sign);
537	548
538		if (base != 10) {
	549	if (base != 0) {
539	550	jim_wide value = strtoull(str + i, endptr, base);
540	551	if (endptr == NULL \|\| *endptr != str + i) {
541	552	return value * sign;

625	636	fprintf(stderr, "\n\n");
626	637	va_end(ap);
627	638
628		#ifdef HAVE_BACKTRACE
	639	#if defined(HAVE_BACKTRACE)
629	640	{
630	641	void *array[40];
631	642	int size, i;

713	724	return key;
714	725	}
715	726
716		/* Generic hash function (we are using to multiply by 9 and add the byte
717		* as Tcl) */
718		unsigned int Jim_GenHashFunction(const unsigned char *buf, int len)
719		{
720		unsigned int h = 0;
721
722		while (len--)
723		h += (h << 3) + *buf++;
724		return h;
	727	/* Generic string hash function */
	728	unsigned int Jim_GenHashFunction(const unsigned char *string, int length)
	729	{
	730	unsigned result = 0;
	731	string += length;
	732	while (length--) {
	733	result += (result << 3) + (unsigned char)(*--string);
	734	}
	735	return result;
725	736	}
726	737
727	738	/* ----------------------------- API implementation ------------------------- */

820	831	*ht = n;
821	832	}
822	833
823		/* Add an element to the target hash table */
	834	/* Add an element to the target hash table
	835	* Returns JIM_ERR if the entry already exists
	836	*/
824	837	int Jim_AddHashEntry(Jim_HashTable ht, const void key, void *val)
825	838	{
826		Jim_HashEntry *entry;
827
828		/* Get the index of the new element, or -1 if
829		* the element already exists. */
830		entry = JimInsertHashEntry(ht, key, 0);
	839	Jim_HashEntry *entry = JimInsertHashEntry(ht, key, 0);;
831	840	if (entry == NULL)
832	841	return JIM_ERR;
833	842

873	882	return existed;
874	883	}
875	884
876		/* Search and remove an element */
	885	/**
	886	* Search the hash table for the given key.
	887	* If found, removes the hash entry and returns JIM_OK.
	888	* Otherwise returns JIM_ERR.
	889	*/
877	890	int Jim_DeleteHashEntry(Jim_HashTable ht, const void key)
878	891	{
879		unsigned int h;
880		Jim_HashEntry he, prevHe;
881
882		if (ht->used == 0)
883		return JIM_ERR;
884		h = Jim_HashKey(ht, key) & ht->sizemask;
885		he = ht->table[h];
886
887		prevHe = NULL;
888		while (he) {
889		if (Jim_CompareHashKeys(ht, key, he->key)) {
890		/* Unlink the element from the list */
891		if (prevHe)
892		prevHe->next = he->next;
893		else
894		ht->table[h] = he->next;
895		Jim_FreeEntryKey(ht, he);
896		Jim_FreeEntryVal(ht, he);
897		Jim_Free(he);
898		ht->used--;
899		return JIM_OK;
900		}
901		prevHe = he;
902		he = he->next;
903		}
904		return JIM_ERR; /* not found */
905		}
906
907		/* Remove all entries from the hash table
908		* and leave it empty for reuse
	892	if (ht->used) {
	893	unsigned int h = Jim_HashKey(ht, key) & ht->sizemask;
	894	Jim_HashEntry *prevHe = NULL;
	895	Jim_HashEntry *he = ht->table[h];
	896
	897	while (he) {
	898	if (Jim_CompareHashKeys(ht, key, he->key)) {
	899	/* Unlink the element from the list */
	900	if (prevHe)
	901	prevHe->next = he->next;
	902	else
	903	ht->table[h] = he->next;
	904	ht->used--;
	905	Jim_FreeEntryKey(ht, he);
	906	Jim_FreeEntryVal(ht, he);
	907	Jim_Free(he);
	908	return JIM_OK;
	909	}
	910	prevHe = he;
	911	he = he->next;
	912	}
	913	}
	914	/* not found */
	915	return JIM_ERR;
	916	}
	917
	918	/**
	919	* Clear all hash entries from the table, but don't free
	920	* the table.
909	921	*/
910		int Jim_FreeHashTable(Jim_HashTable *ht)
	922	void Jim_ClearHashTable(Jim_HashTable *ht)
911	923	{
912	924	unsigned int i;
913	925

915	927	for (i = 0; ht->used > 0; i++) {
916	928	Jim_HashEntry he, nextHe;
917	929
918		if ((he = ht->table[i]) == NULL)
919		continue;
	930	he = ht->table[i];
920	931	while (he) {
921	932	nextHe = he->next;
922	933	Jim_FreeEntryKey(ht, he);

925	936	ht->used--;
926	937	he = nextHe;
927	938	}
928		}
	939	ht->table[i] = NULL;
	940	}
	941	}
	942
	943	/* Remove all entries from the hash table
	944	* and leave it empty for reuse
	945	*/
	946	int Jim_FreeHashTable(Jim_HashTable *ht)
	947	{
	948	Jim_ClearHashTable(ht);
929	949	/* Free the table and the allocated cache structure */
930	950	Jim_Free(ht->table);
931	951	/* Re-initialize the table */

1008	1028
1009	1029	/* Returns the index of a free slot that can be populated with
1010	1030	* a hash entry for the given 'key'.
1011		* If the key already exists, -1 is returned. */
	1031	* If the key already exists the result depends upon whether 'replace' is set.
	1032	* If replace is false, returns NULL.
	1033	* Otherwise returns the existing hash entry.
	1034	* Note that existing vs new cases can be distinguished because he->key will be NULL
	1035	* if the key is new
	1036	*/
1012	1037	static Jim_HashEntry JimInsertHashEntry(Jim_HashTable ht, const void *key, int replace)
1013	1038	{
1014	1039	unsigned int h;

1251	1276	pc->tend = pc->p - 1;
1252	1277	pc->tline = pc->linenr;
1253	1278	pc->tt = JIM_TT_EOL;
	1279	if (pc->inquote) {
	1280	pc->missing.ch = '"';
	1281	}
1254	1282	pc->eof = 1;
1255	1283	return JIM_OK;
1256	1284	}

1508	1536	case '"':
1509	1537	if (startofword) {
1510	1538	JimParseSubQuote(pc);
	1539	if (pc->missing.ch == '"') {
	1540	return;
	1541	}
1511	1542	continue;
1512	1543	}
1513	1544	break;

2544	2575	*/
2545	2576	int Jim_StringMatchObj(Jim_Interp interp, Jim_Obj patternObjPtr, Jim_Obj *objPtr, int nocase)
2546	2577	{
2547		return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase);
2548		}
2549
2550		/*
2551		* Note: does not support embedded nulls for the nocase option.
2552		*/
	2578	int plen, slen;
	2579	const char *pattern = Jim_GetString(patternObjPtr, &plen);
	2580	const char *string = Jim_GetString(objPtr, &slen);
	2581	return JimGlobMatch(pattern, plen, string, slen, nocase);
	2582	}
	2583
2553	2584	int Jim_StringCompareObj(Jim_Interp interp, Jim_Obj firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2554	2585	{
2555		int l1, l2;
2556		const char *s1 = Jim_GetString(firstObjPtr, &l1);
2557		const char *s2 = Jim_GetString(secondObjPtr, &l2);
2558
2559		if (nocase) {
2560		/* Do a character compare for nocase */
2561		return JimStringCompareLen(s1, s2, -1, nocase);
2562		}
2563		return JimStringCompare(s1, l1, s2, l2);
2564		}
2565
2566		/**
2567		* Like Jim_StringCompareObj() except compares to a maximum of the length of firstObjPtr.
2568		*
2569		* Note: does not support embedded nulls
2570		*/
2571		int Jim_StringCompareLenObj(Jim_Interp interp, Jim_Obj firstObjPtr, Jim_Obj *secondObjPtr, int nocase)
2572		{
2573	2586	const char *s1 = Jim_String(firstObjPtr);
	2587	int l1 = Jim_Utf8Length(interp, firstObjPtr);
2574	2588	const char *s2 = Jim_String(secondObjPtr);
2575
2576		return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase);
	2589	int l2 = Jim_Utf8Length(interp, secondObjPtr);
	2590	return JimStringCompareUtf8(s1, l1, s2, l2, nocase);
2577	2591	}
2578	2592
2579	2593	/* Convert a range, as returned by Jim_GetRange(), into

2583	2597	* is out of range. */
2584	2598	static int JimRelToAbsIndex(int len, int idx)
2585	2599	{
2586		if (idx < 0)
	2600	if (idx < 0 && idx > -INT_MAX)
2587	2601	return len + idx;
2588	2602	return idx;
2589	2603	}

3196	3210	FreeScriptInternalRep,
3197	3211	DupScriptInternalRep,
3198	3212	NULL,
3199		JIM_TYPE_REFERENCES,
	3213	JIM_TYPE_NONE,
3200	3214	};
3201	3215
3202	3216	/* Each token of a script is represented by a ScriptToken.

3754	3768	/* -----------------------------------------------------------------------------
3755	3769	* Commands
3756	3770	* ---------------------------------------------------------------------------*/
	3771	void Jim_InterpIncrProcEpoch(Jim_Interp *interp)
	3772	{
	3773	interp->procEpoch++;
	3774
	3775	/* Now discard all out-of-date Jim_Cmd entries */
	3776	while (interp->oldCmdCache) {
	3777	Jim_Cmd *next = interp->oldCmdCache->prevCmd;
	3778	Jim_Free(interp->oldCmdCache);
	3779	interp->oldCmdCache = next;
	3780	}
	3781	interp->oldCmdCacheSize = 0;
	3782	}
	3783
3757	3784	static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr)
3758	3785	{
3759	3786	cmdPtr->inUse++;

3781	3808	/* Delete any pushed command too */
3782	3809	JimDecrCmdRefCount(interp, cmdPtr->prevCmd);
3783	3810	}
3784		Jim_Free(cmdPtr);
	3811
	3812	if (interp->quitting) {
	3813	Jim_Free(cmdPtr);
	3814	}
	3815	else {
	3816	/* Preserve the structure with inUse = 0 so that
	3817	* cached references will continue to work.
	3818	* These will be discarding at the next procEpoch increment
	3819	* or once 1000 have been accumulated.
	3820	*/
	3821	cmdPtr->prevCmd = interp->oldCmdCache;
	3822	interp->oldCmdCache = cmdPtr;
	3823	if (++interp->oldCmdCacheSize >= 1000) {
	3824	Jim_InterpIncrProcEpoch(interp);
	3825	}
	3826	}
3785	3827	}
3786	3828	}
3787	3829

3795	3837	Jim_Free(val);
3796	3838	}
3797	3839
	3840	static unsigned int JimObjectHTHashFunction(const void *key)
	3841	{
	3842	Jim_Obj keyObj = (Jim_Obj )key;
	3843	int length;
	3844	const char *string;
	3845
	3846	#ifdef JIM_OPTIMIZATION
	3847	if (JimIsWide(keyObj) && keyObj->bytes == NULL) {
	3848	/* Special case: we can compute the hash of integers numerically. */
	3849	jim_wide objValue = JimWideValue(keyObj);
	3850	if (objValue > INT_MIN && objValue < INT_MAX) {
	3851	unsigned result = 0;
	3852	unsigned value = (unsigned)objValue;
	3853
	3854	if (objValue < 0) { /* wrap to positive (remove sign) */
	3855	value = (unsigned)-objValue;
	3856	}
	3857
	3858	/* important: use do-cycle, because value could be 0 */
	3859	do {
	3860	result += (result << 3) + (value % 10 + '0');
	3861	value /= 10;
	3862	} while (value);
	3863
	3864	if (objValue < 0) { /* negative, sign as char */
	3865	result += (result << 3) + '-';
	3866	}
	3867	return result;
	3868	}
	3869	}
	3870	#endif
	3871	string = Jim_GetString(keyObj, &length);
	3872	return Jim_GenHashFunction((const unsigned char *)string, length);
	3873	}
	3874
	3875	static int JimObjectHTKeyCompare(void privdata, const void key1, const void *key2)
	3876	{
	3877	return Jim_StringEqObj((Jim_Obj )key1, (Jim_Obj )key2);
	3878	}
	3879
	3880	static void JimObjectHTKeyValDup(void privdata, const void *val)
	3881	{
	3882	Jim_IncrRefCount((Jim_Obj *)val);
	3883	return (void *)val;
	3884	}
	3885
	3886	static void JimObjectHTKeyValDestructor(void interp, void val)
	3887	{
	3888	Jim_DecrRefCount(interp, (Jim_Obj *)val);
	3889	}
	3890
	3891
3798	3892	static const Jim_HashTableType JimVariablesHashTableType = {
3799		JimStringCopyHTHashFunction, /* hash function */
3800		JimStringCopyHTDup, /* key dup */
	3893	JimObjectHTHashFunction, /* hash function */
	3894	JimObjectHTKeyValDup, /* key dup */
3801	3895	NULL, /* val dup */
3802		JimStringCopyHTKeyCompare, /* key compare */
3803		JimStringCopyHTKeyDestructor, /* key destructor */
	3896	JimObjectHTKeyCompare, /* key compare */
	3897	JimObjectHTKeyValDestructor, /* key destructor */
3804	3898	JimVariablesHTValDestructor /* val destructor */
3805	3899	};
3806	3900
3807	3901	/* Commands HashTable Type.
3808	3902	*
3809		* Keys are dynamic allocated strings, Values are Jim_Cmd structures.
	3903	* Keys are Jim Objects where any leading namespace qualifier
	3904	* is ignored. Values are Jim_Cmd structures.
3810	3905	*/
	3906
	3907	/**
	3908	* Like Jim_GetString() but strips any leading namespace qualifier.
	3909	*/
	3910	static const char Jim_GetStringNoQualifier(Jim_Obj objPtr, int *length)
	3911	{
	3912	int len;
	3913	const char *str = Jim_GetString(objPtr, &len);
	3914	if (len >= 2 && str[0] == ':' && str[1] == ':') {
	3915	while (len && *str == ':') {
	3916	len--;
	3917	str++;
	3918	}
	3919	}
	3920	*length = len;
	3921	return str;
	3922	}
	3923
	3924	static unsigned int JimCommandsHT_HashFunction(const void *key)
	3925	{
	3926	int len;
	3927	const char str = Jim_GetStringNoQualifier((Jim_Obj )key, &len);
	3928	return Jim_GenHashFunction((const unsigned char *)str, len);
	3929	}
	3930
	3931	static int JimCommandsHT_KeyCompare(void privdata, const void key1, const void *key2)
	3932	{
	3933	int len1, len2;
	3934	const char str1 = Jim_GetStringNoQualifier((Jim_Obj )key1, &len1);
	3935	const char str2 = Jim_GetStringNoQualifier((Jim_Obj )key2, &len2);
	3936	return len1 == len2 && memcmp(str1, str2, len1) == 0;
	3937	}
	3938
3811	3939	static void JimCommandsHT_ValDestructor(void interp, void val)
3812	3940	{
3813	3941	JimDecrCmdRefCount(interp, val);
3814	3942	}
3815	3943
3816	3944	static const Jim_HashTableType JimCommandsHashTableType = {
3817		JimStringCopyHTHashFunction, /* hash function */
3818		JimStringCopyHTDup, /* key dup */
	3945	JimCommandsHT_HashFunction, /* hash function */
	3946	JimObjectHTKeyValDup, /* key dup */
3819	3947	NULL, /* val dup */
3820		JimStringCopyHTKeyCompare, /* key compare */
3821		JimStringCopyHTKeyDestructor, /* key destructor */
	3948	JimCommandsHT_KeyCompare, /* key compare */
	3949	JimObjectHTKeyValDestructor, /* key destructor */
3822	3950	JimCommandsHT_ValDestructor /* val destructor */
3823	3951	};
3824	3952
3825	3953	/* ------------------------- Commands related functions --------------------- */
3826
3827		#ifdef jim_ext_namespace
3828		/**
3829		* Returns the "unscoped" version of the given namespace.
3830		* That is, the fully qualified name without the leading ::
3831		* The returned value is either nsObj, or an object with a zero ref count.
3832		*/
3833		static Jim_Obj JimQualifyNameObj(Jim_Interp interp, Jim_Obj *nsObj)
3834		{
3835		const char *name = Jim_String(nsObj);
3836		if (name[0] == ':' && name[1] == ':') {
3837		/* This command is being defined in the global namespace */
3838		while (*++name == ':') {
3839		}
3840		nsObj = Jim_NewStringObj(interp, name, -1);
3841		}
3842		else if (Jim_Length(interp->framePtr->nsObj)) {
3843		/* This command is being defined in a non-global namespace */
3844		nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3845		Jim_AppendStrings(interp, nsObj, "::", name, NULL);
3846		}
3847		return nsObj;
3848		}
3849	3954
3850	3955	/**
3851	3956	* If nameObjPtr starts with "::", returns it.

3854	3959	*/
3855	3960	Jim_Obj Jim_MakeGlobalNamespaceName(Jim_Interp interp, Jim_Obj *nameObjPtr)
3856	3961	{
	3962	#ifdef jim_ext_namespace
3857	3963	Jim_Obj *resultObj;
3858	3964
3859	3965	const char *name = Jim_String(nameObjPtr);

3866	3972	Jim_DecrRefCount(interp, nameObjPtr);
3867	3973
3868	3974	return resultObj;
	3975	#else
	3976	return nameObjPtr;
	3977	#endif
3869	3978	}
3870	3979
3871	3980	/**
3872		* An efficient version of JimQualifyNameObj() where the name is
3873		* available (and needed) as a 'const char *'.
3874		* Avoids creating an object if not necessary.
3875		* The object stored in *objPtrPtr should be disposed of with JimFreeQualifiedName() after use.
	3981	* If the name in objPtr is not fully qualified, and a non-global namespace
	3982	* is in effect, qualifies the name with the current namespace and returns the new name.
	3983	* Otherwise returns objPtr.
	3984	*
	3985	* In either case the ref count is incremented and should be decremented by the caller.
	3986	* with Jim_DecrRefCount()
3876	3987	*/
3877		static const char JimQualifyName(Jim_Interp interp, const char name, Jim_Obj *objPtrPtr)
3878		{
3879		Jim_Obj *objPtr = interp->emptyObj;
3880
3881		if (name[0] == ':' && name[1] == ':') {
3882		/* This command is being defined in the global namespace */
3883		while (*++name == ':') {
3884		}
3885		}
3886		else if (Jim_Length(interp->framePtr->nsObj)) {
3887		/* This command is being defined in a non-global namespace */
3888		objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
3889		Jim_AppendStrings(interp, objPtr, "::", name, NULL);
3890		name = Jim_String(objPtr);
3891		}
	3988	static Jim_Obj JimQualifyName(Jim_Interp interp, Jim_Obj *objPtr)
	3989	{
	3990	#ifdef jim_ext_namespace
	3991	if (Jim_Length(interp->framePtr->nsObj)) {
	3992	int len;
	3993	const char *name = Jim_GetString(objPtr, &len);
	3994	if (len < 2 \|\| name[0] != ':' \|\| name[1] != ':') {
	3995	/* OK. Need to qualify this name */
	3996	objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
	3997	Jim_AppendStrings(interp, objPtr, "::", name, NULL);
	3998	}
	3999	}
	4000	#endif
3892	4001	Jim_IncrRefCount(objPtr);
3893		*objPtrPtr = objPtr;
3894		return name;
3895		}
3896
3897		#define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ))
3898
3899		#else
3900		/* We can be more efficient in the no-namespace case */
3901		#define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME))
3902		#define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY)
3903
3904		Jim_Obj Jim_MakeGlobalNamespaceName(Jim_Interp interp, Jim_Obj *nameObjPtr)
3905		{
3906		return nameObjPtr;
3907		}
3908		#endif
3909
3910		static int JimCreateCommand(Jim_Interp interp, const char name, Jim_Cmd *cmd)
3911		{
	4002	return objPtr;
	4003	}
	4004
	4005	/**
	4006	* Add the command to the commands hash table
	4007	*/
	4008	static void JimCreateCommand(Jim_Interp interp, Jim_Obj nameObjPtr, Jim_Cmd *cmd)
	4009	{
	4010	/* If the entry already exists, nameObjPtr will not be used,
	4011	* so the refCount of nameObjPtr can't be zero, relying on this function to
	4012	* release it in that case.
	4013	*/
	4014	JimPanic((nameObjPtr->refCount == 0, "JimCreateCommand called with zero ref count name"));
	4015
3912	4016	/* It may already exist, so we try to delete the old one.
3913	4017	* Note that reference count means that it won't be deleted yet if
3914	4018	* it exists in the call stack.

3916	4020	* BUT, if 'local' is in force, instead of deleting the existing
3917	4021	* proc, we stash a reference to the old proc here.
3918	4022	*/
3919		Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name);
3920		if (he) {
3921		/* There was an old cmd with the same name,
3922		* so this requires a 'proc epoch' update. */
3923
3924		/* If a procedure with the same name didn't exist there is no need
3925		* to increment the 'proc epoch' because creation of a new procedure
3926		* can never affect existing cached commands. We don't do
3927		* negative caching. */
3928		Jim_InterpIncrProcEpoch(interp);
3929		}
3930
3931		if (he && interp->local) {
3932		/* Push this command over the top of the previous one */
3933		cmd->prevCmd = Jim_GetHashEntryVal(he);
3934		Jim_SetHashVal(&interp->commands, he, cmd);
3935		}
3936		else {
	4023	if (interp->local) {
	4024	Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, nameObjPtr);
3937	4025	if (he) {
3938		/* Replace the existing command */
3939		Jim_DeleteHashEntry(&interp->commands, name);
3940		}
3941
3942		Jim_AddHashEntry(&interp->commands, name, cmd);
3943		}
3944		return JIM_OK;
3945		}
3946
3947
3948		int Jim_CreateCommand(Jim_Interp interp, const char cmdNameStr,
	4026	/* Push this command over the top of the previous one */
	4027	cmd->prevCmd = Jim_GetHashEntryVal(he);
	4028	Jim_SetHashVal(&interp->commands, he, cmd);
	4029	/* Need to increment the proc epoch here so that the new command will be used */
	4030	Jim_InterpIncrProcEpoch(interp);
	4031	return;
	4032	}
	4033	}
	4034
	4035	/* Otherwise simply replace any existing command */
	4036
	4037	/* Note that it is not necessary to increment the 'proc epoch' because any
	4038	* existing command that is replace will be held as a negative cache entry
	4039	* until the next time the proc epoch is incremented.
	4040	*/
	4041	Jim_ReplaceHashEntry(&interp->commands, nameObjPtr, cmd);
	4042	}
	4043
	4044	int Jim_CreateCommandObj(Jim_Interp interp, Jim_Obj cmdNameObj,
3949	4045	Jim_CmdProc cmdProc, void privData, Jim_DelCmdProc *delProc)
3950	4046	{
3951	4047	Jim_Cmd cmdPtr = Jim_Alloc(sizeof(cmdPtr));

3957	4053	cmdPtr->u.native.cmdProc = cmdProc;
3958	4054	cmdPtr->u.native.privData = privData;
3959	4055
3960		JimCreateCommand(interp, cmdNameStr, cmdPtr);
	4056	Jim_IncrRefCount(cmdNameObj);
	4057	JimCreateCommand(interp, cmdNameObj, cmdPtr);
	4058	Jim_DecrRefCount(interp, cmdNameObj);
3961	4059
3962	4060	return JIM_OK;
	4061	}
	4062
	4063
	4064	int Jim_CreateCommand(Jim_Interp interp, const char cmdNameStr,
	4065	Jim_CmdProc cmdProc, void privData, Jim_DelCmdProc *delProc)
	4066	{
	4067	return Jim_CreateCommandObj(interp, Jim_NewStringObj(interp, cmdNameStr, -1), cmdProc, privData, delProc);
3963	4068	}
3964	4069
3965	4070	static int JimCreateProcedureStatics(Jim_Interp interp, Jim_Cmd cmdPtr, Jim_Obj *staticsListObjPtr)

3997	4102	else {
3998	4103	initObjPtr = Jim_ListGetIndex(interp, objPtr, 1);
3999	4104	}
4000		if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) {
4001		return JIM_ERR;
4002		}
4003	4105
4004	4106	varPtr = Jim_Alloc(sizeof(*varPtr));
4005	4107	varPtr->objPtr = initObjPtr;
4006	4108	Jim_IncrRefCount(initObjPtr);
4007	4109	varPtr->linkFramePtr = NULL;
4008		if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars,
4009		Jim_String(nameObjPtr), varPtr) != JIM_OK) {
	4110	if (JimSetNewVariable(cmdPtr->u.proc.staticVars, nameObjPtr, varPtr) != JIM_OK) {
4010	4111	Jim_SetResultFormatted(interp,
4011	4112	"static variable name \"%#s\" duplicated in statics list", nameObjPtr);
4012	4113	Jim_DecrRefCount(interp, initObjPtr);

4023	4124	return JIM_OK;
4024	4125	}
4025	4126
	4127	/* memrchr() is not standard */
	4128	#ifdef jim_ext_namespace
	4129	static const char Jim_memrchr(const char p, int c, int len)
	4130	{
	4131	int i;
	4132	for (i = len; i > 0; i--) {
	4133	if (p[i] == c) {
	4134	return p + i;
	4135	}
	4136	}
	4137	return NULL;
	4138	}
	4139	#endif
	4140
4026	4141	/**
4027	4142	* If the command is a proc, sets/updates the cached namespace (nsObj)
4028	4143	* based on the command name.
4029	4144	*/
4030		static void JimUpdateProcNamespace(Jim_Interp interp, Jim_Cmd cmdPtr, const char *cmdname)
	4145	static void JimUpdateProcNamespace(Jim_Interp interp, Jim_Cmd cmdPtr, Jim_Obj *nameObjPtr)
4031	4146	{
4032	4147	#ifdef jim_ext_namespace
4033	4148	if (cmdPtr->isproc) {
	4149	int len;
	4150	const char *cmdname = Jim_GetStringNoQualifier(nameObjPtr, &len);
4034	4151	/* XXX: Really need JimNamespaceSplit() */
4035		const char *pt = strrchr(cmdname, ':');
	4152	const char *pt = Jim_memrchr(cmdname, ':', len);
4036	4153	if (pt && pt != cmdname && pt[-1] == ':') {
	4154	pt++;
	4155	/* Now pt points to the base name .e.g. ::abc::def::ghi points to ghi
	4156	* while cmdname points to abc
	4157	*/
4037	4158	Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj);
4038		cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1);
	4159	cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 2);
4039	4160	Jim_IncrRefCount(cmdPtr->u.proc.nsObj);
4040	4161
4041		if (Jim_FindHashEntry(&interp->commands, pt + 1)) {
	4162	Jim_Obj *tempObj = Jim_NewStringObj(interp, pt, len - (pt - cmdname));
	4163	if (Jim_FindHashEntry(&interp->commands, tempObj)) {
4042	4164	/* This command shadows a global command, so a proc epoch update is required */
4043	4165	Jim_InterpIncrProcEpoch(interp);
4044	4166	}
	4167	Jim_FreeNewObj(interp, tempObj);
4045	4168	}
4046	4169	}
4047	4170	#endif

4058	4181
4059	4182	/* Allocate space for both the command pointer and the arg list */
4060	4183	cmdPtr = Jim_Alloc(sizeof(cmdPtr) + sizeof(struct Jim_ProcArg) argListLen);
	4184	assert(cmdPtr);
4061	4185	memset(cmdPtr, 0, sizeof(*cmdPtr));
4062	4186	cmdPtr->inUse = 1;
4063	4187	cmdPtr->isproc = 1;

4133	4257	return cmdPtr;
4134	4258	}
4135	4259
4136		int Jim_DeleteCommand(Jim_Interp interp, const char name)
	4260	int Jim_DeleteCommand(Jim_Interp interp, Jim_Obj nameObj)
4137	4261	{
4138	4262	int ret = JIM_OK;
4139		Jim_Obj *qualifiedNameObj;
4140		const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj);
4141
4142		if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) {
4143		Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name);
	4263
	4264	nameObj = JimQualifyName(interp, nameObj);
	4265
	4266	if (Jim_DeleteHashEntry(&interp->commands, nameObj) == JIM_ERR) {
	4267	Jim_SetResultFormatted(interp, "can't delete \"%#s\": command doesn't exist", nameObj);
4144	4268	ret = JIM_ERR;
4145	4269	}
4146		else {
4147		Jim_InterpIncrProcEpoch(interp);
4148		}
4149
4150		JimFreeQualifiedName(interp, qualifiedNameObj);
	4270	Jim_DecrRefCount(interp, nameObj);
4151	4271
4152	4272	return ret;
4153	4273	}
4154	4274
4155		int Jim_RenameCommand(Jim_Interp interp, const char oldName, const char *newName)
	4275	int Jim_RenameCommand(Jim_Interp interp, Jim_Obj oldNameObj, Jim_Obj *newNameObj)
4156	4276	{
4157	4277	int ret = JIM_ERR;
4158	4278	Jim_HashEntry *he;
4159	4279	Jim_Cmd *cmdPtr;
4160		Jim_Obj *qualifiedOldNameObj;
4161		Jim_Obj *qualifiedNewNameObj;
4162		const char *fqold;
4163		const char *fqnew;
4164
4165		if (newName[0] == 0) {
4166		return Jim_DeleteCommand(interp, oldName);
4167		}
4168
4169		fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj);
4170		fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj);
	4280
	4281	if (Jim_Length(newNameObj) == 0) {
	4282	return Jim_DeleteCommand(interp, oldNameObj);
	4283	}
	4284
	4285	/* each name may need to have the current namespace added to it */
	4286
	4287	oldNameObj = JimQualifyName(interp, oldNameObj);
	4288	newNameObj = JimQualifyName(interp, newNameObj);
4171	4289
4172	4290	/* Does it exist? */
4173		he = Jim_FindHashEntry(&interp->commands, fqold);
	4291	he = Jim_FindHashEntry(&interp->commands, oldNameObj);
4174	4292	if (he == NULL) {
4175		Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName);
4176		}
4177		else if (Jim_FindHashEntry(&interp->commands, fqnew)) {
4178		Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName);
	4293	Jim_SetResultFormatted(interp, "can't rename \"%#s\": command doesn't exist", oldNameObj);
	4294	}
	4295	else if (Jim_FindHashEntry(&interp->commands, newNameObj)) {
	4296	Jim_SetResultFormatted(interp, "can't rename to \"%#s\": command already exists", newNameObj);
4179	4297	}
4180	4298	else {
4181		/* Add the new name first */
4182	4299	cmdPtr = Jim_GetHashEntryVal(he);
4183		JimIncrCmdRefCount(cmdPtr);
4184		JimUpdateProcNamespace(interp, cmdPtr, fqnew);
4185		Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr);
4186
4187		/* Now remove the old name */
4188		Jim_DeleteHashEntry(&interp->commands, fqold);
4189
4190		/* Increment the epoch */
4191		Jim_InterpIncrProcEpoch(interp);
4192
4193		ret = JIM_OK;
4194		}
4195
4196		JimFreeQualifiedName(interp, qualifiedOldNameObj);
4197		JimFreeQualifiedName(interp, qualifiedNewNameObj);
	4300	if (cmdPtr->prevCmd) {
	4301	/* If the command replaced another command with 'local', renaming it
	4302	* would break the usage of upcall, so don't allow it.
	4303	*/
	4304	Jim_SetResultFormatted(interp, "can't rename local command \"%#s\"", oldNameObj);
	4305	}
	4306	else {
	4307	/* Add the new name first */
	4308	JimIncrCmdRefCount(cmdPtr);
	4309	JimUpdateProcNamespace(interp, cmdPtr, newNameObj);
	4310	Jim_AddHashEntry(&interp->commands, newNameObj, cmdPtr);
	4311
	4312	/* Now remove the old name */
	4313	Jim_DeleteHashEntry(&interp->commands, oldNameObj);
	4314
	4315	/* Increment the epoch */
	4316	Jim_InterpIncrProcEpoch(interp);
	4317
	4318	ret = JIM_OK;
	4319	}
	4320	}
	4321
	4322	Jim_DecrRefCount(interp, oldNameObj);
	4323	Jim_DecrRefCount(interp, newNameObj);
4198	4324
4199	4325	return ret;
4200	4326	}

4238	4364	/* In order to be valid, the proc epoch must match and
4239	4365	* the lookup must have occurred in the same namespace
4240	4366	*/
4241		if (objPtr->typePtr != &commandObjType \|\|
4242		objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch
	4367	if (objPtr->typePtr == &commandObjType
	4368	&& objPtr->internalRep.cmdValue.procEpoch == interp->procEpoch
4243	4369	#ifdef jim_ext_namespace
4244		\|\| !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
	4370	&& Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj)
4245	4371	#endif
4246		) {
4247		/* Not cached or out of date, so lookup */
4248
4249		/* Do we need to try the local namespace? */
4250		const char *name = Jim_String(objPtr);
4251		Jim_HashEntry *he;
4252
4253		if (name[0] == ':' && name[1] == ':') {
4254		while (*++name == ':') {
4255		}
4256		}
	4372	&& objPtr->internalRep.cmdValue.cmdPtr->inUse) {
	4373	/* Cached value is valid */
	4374	cmd = objPtr->internalRep.cmdValue.cmdPtr;
	4375	}
	4376	else {
	4377	Jim_Obj *qualifiedNameObj = JimQualifyName(interp, objPtr);
	4378	Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, qualifiedNameObj);
4257	4379	#ifdef jim_ext_namespace
4258		else if (Jim_Length(interp->framePtr->nsObj)) {
4259		/* This command is being defined in a non-global namespace */
4260		Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj);
4261		Jim_AppendStrings(interp, nameObj, "::", name, NULL);
4262		he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj));
4263		Jim_FreeNewObj(interp, nameObj);
4264		if (he) {
4265		goto found;
4266		}
	4380	if (he == NULL && Jim_Length(interp->framePtr->nsObj)) {
	4381	he = Jim_FindHashEntry(&interp->commands, objPtr);
4267	4382	}
4268	4383	#endif
4269
4270		/* Lookup in the global namespace */
4271		he = Jim_FindHashEntry(&interp->commands, name);
4272	4384	if (he == NULL) {
4273	4385	if (flags & JIM_ERRMSG) {
4274	4386	Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr);
4275	4387	}
	4388	Jim_DecrRefCount(interp, qualifiedNameObj);
4276	4389	return NULL;
4277	4390	}
4278		#ifdef jim_ext_namespace
4279		found:
4280		#endif
4281	4391	cmd = Jim_GetHashEntryVal(he);
4282	4392
4283	4393	/* Free the old internal rep and set the new one. */

4287	4397	objPtr->internalRep.cmdValue.cmdPtr = cmd;
4288	4398	objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj;
4289	4399	Jim_IncrRefCount(interp->framePtr->nsObj);
4290		}
4291		else {
4292		cmd = objPtr->internalRep.cmdValue.cmdPtr;
	4400	Jim_DecrRefCount(interp, qualifiedNameObj);
4293	4401	}
4294	4402	while (cmd->u.proc.upcall) {
4295	4403	cmd = cmd->prevCmd;

4317	4425	JIM_TYPE_REFERENCES,
4318	4426	};
4319	4427
4320		/**
4321		* Check that the name does not contain embedded nulls.
4322		*
4323		* Variable and procedure names are manipulated as null terminated strings, so
4324		* don't allow names with embedded nulls.
4325		*/
4326		static int JimValidName(Jim_Interp interp, const char type, Jim_Obj *nameObjPtr)
4327		{
4328		/* Variable names and proc names can't contain embedded nulls */
4329		if (nameObjPtr->typePtr != &variableObjType) {
4330		int len;
4331		const char *str = Jim_GetString(nameObjPtr, &len);
4332		if (memchr(str, '\0', len)) {
4333		Jim_SetResultFormatted(interp, "%s name contains embedded null", type);
4334		return JIM_ERR;
4335		}
4336		}
4337		return JIM_OK;
4338		}
4339
4340	4428	/* This method should be called only by the variable API.
4341	4429	* It returns JIM_OK on success (variable already exists),
4342	4430	* JIM_ERR if it does not exist, JIM_DICT_SUGAR if it's not

4346	4434	{
4347	4435	const char *varName;
4348	4436	Jim_CallFrame *framePtr;
4349		Jim_HashEntry *he;
4350	4437	int global;
4351	4438	int len;
	4439	Jim_Var *var;
4352	4440
4353	4441	/* Check if the object is already an uptodate variable */
4354	4442	if (objPtr->typePtr == &variableObjType) {

4362	4450	else if (objPtr->typePtr == &dictSubstObjType) {
4363	4451	return JIM_DICT_SUGAR;
4364	4452	}
4365		else if (JimValidName(interp, "variable", objPtr) != JIM_OK) {
4366		return JIM_ERR;
4367		}
4368
4369	4453
4370	4454	varName = Jim_GetString(objPtr, &len);
4371	4455

4375	4459	}
4376	4460
4377	4461	if (varName[0] == ':' && varName[1] == ':') {
4378		while (*++varName == ':') {
	4462	while (*varName == ':') {
	4463	varName++;
	4464	len--;
4379	4465	}
4380	4466	global = 1;
4381	4467	framePtr = interp->topFramePtr;
	4468	/* XXX should use length */
	4469	Jim_Obj *tempObj = Jim_NewStringObj(interp, varName, len);
	4470	var = JimFindVariable(&framePtr->vars, tempObj);
	4471	Jim_FreeNewObj(interp, tempObj);
4382	4472	}
4383	4473	else {
4384	4474	global = 0;
4385	4475	framePtr = interp->framePtr;
4386		}
4387
4388		/* Resolve this name in the variables hash table */
4389		he = Jim_FindHashEntry(&framePtr->vars, varName);
4390		if (he == NULL) {
4391		if (!global && framePtr->staticVars) {
	4476	/* Resolve this name in the variables hash table */
	4477	var = JimFindVariable(&framePtr->vars, objPtr);
	4478	if (var == NULL && framePtr->staticVars) {
4392	4479	/* Try with static vars. */
4393		he = Jim_FindHashEntry(framePtr->staticVars, varName);
4394		}
4395		if (he == NULL) {
4396		return JIM_ERR;
4397		}
	4480	var = JimFindVariable(framePtr->staticVars, objPtr);
	4481	}
	4482	}
	4483
	4484	if (var == NULL) {
	4485	return JIM_ERR;
4398	4486	}
4399	4487
4400	4488	/* Free the old internal repr and set the new one. */
4401	4489	Jim_FreeIntRep(interp, objPtr);
4402	4490	objPtr->typePtr = &variableObjType;
4403	4491	objPtr->internalRep.varValue.callFrameId = framePtr->id;
4404		objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he);
	4492	objPtr->internalRep.varValue.varPtr = var;
4405	4493	objPtr->internalRep.varValue.global = global;
4406	4494	return JIM_OK;
4407	4495	}

4410	4498	static int JimDictSugarSet(Jim_Interp interp, Jim_Obj ObjPtr, Jim_Obj *valObjPtr);
4411	4499	static Jim_Obj JimDictSugarGet(Jim_Interp interp, Jim_Obj *ObjPtr, int flags);
4412	4500
	4501	static int JimSetNewVariable(Jim_HashTable ht, Jim_Obj nameObjPtr, Jim_Var *var)
	4502	{
	4503	return Jim_AddHashEntry(ht, nameObjPtr, var);
	4504	}
	4505
	4506	static Jim_Var JimFindVariable(Jim_HashTable ht, Jim_Obj *nameObjPtr)
	4507	{
	4508	Jim_HashEntry *he = Jim_FindHashEntry(ht, nameObjPtr);
	4509	if (he) {
	4510	return (Jim_Var *)Jim_GetHashEntryVal(he);
	4511	}
	4512	return NULL;
	4513	}
	4514
	4515	static int JimUnsetVariable(Jim_HashTable ht, Jim_Obj nameObjPtr)
	4516	{
	4517	return Jim_DeleteHashEntry(ht, nameObjPtr);
	4518	}
	4519
4413	4520	static Jim_Var JimCreateVariable(Jim_Interp interp, Jim_Obj nameObjPtr, Jim_Obj valObjPtr)
4414	4521	{
4415	4522	const char *name;
4416	4523	Jim_CallFrame *framePtr;
4417	4524	int global;
	4525	int len;
4418	4526
4419	4527	/* New variable to create */
4420	4528	Jim_Var var = Jim_Alloc(sizeof(var));

4423	4531	Jim_IncrRefCount(valObjPtr);
4424	4532	var->linkFramePtr = NULL;
4425	4533
4426		name = Jim_String(nameObjPtr);
	4534	name = Jim_GetString(nameObjPtr, &len);
4427	4535	if (name[0] == ':' && name[1] == ':') {
4428		while (*++name == ':') {
	4536	while (*name == ':') {
	4537	name++;
	4538	len--;
4429	4539	}
4430	4540	framePtr = interp->topFramePtr;
4431	4541	global = 1;
	4542	JimSetNewVariable(&framePtr->vars, Jim_NewStringObj(interp, name, len), var);
4432	4543	}
4433	4544	else {
4434	4545	framePtr = interp->framePtr;
4435	4546	global = 0;
4436		}
4437
4438		/* Insert the new variable */
4439		Jim_AddHashEntry(&framePtr->vars, name, var);
	4547	JimSetNewVariable(&framePtr->vars, nameObjPtr, var);
	4548	}
4440	4549
4441	4550	/* Make the object int rep a variable */
4442	4551	Jim_FreeIntRep(interp, nameObjPtr);

4467	4576	return JimDictSugarSet(interp, nameObjPtr, valObjPtr);
4468	4577
4469	4578	case JIM_ERR:
4470		if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) {
4471		return JIM_ERR;
4472		}
4473	4579	JimCreateVariable(interp, nameObjPtr, valObjPtr);
4474	4580	break;
4475	4581

4537	4643	const char *targetName;
4538	4644	Jim_CallFrame *framePtr;
4539	4645	Jim_Var *varPtr;
	4646	int len;
	4647	int varnamelen;
4540	4648
4541	4649	/* Check for an existing variable or link */
4542	4650	switch (SetVariableFromAny(interp, nameObjPtr)) {

4560	4668
4561	4669	/* Resolve the call frames for both variables */
4562	4670	/* XXX: SetVariableFromAny() already did this! */
4563		varName = Jim_String(nameObjPtr);
	4671	varName = Jim_GetString(nameObjPtr, &varnamelen);
4564	4672
4565	4673	if (varName[0] == ':' && varName[1] == ':') {
4566		while (*++varName == ':') {
	4674	while (*varName == ':') {
	4675	varName++;
	4676	varnamelen--;
4567	4677	}
4568	4678	/* Linking a global var does nothing */
4569	4679	framePtr = interp->topFramePtr;

4572	4682	framePtr = interp->framePtr;
4573	4683	}
4574	4684
4575		targetName = Jim_String(targetNameObjPtr);
	4685	targetName = Jim_GetString(targetNameObjPtr, &len);
4576	4686	if (targetName[0] == ':' && targetName[1] == ':') {
4577		while (*++targetName == ':') {
4578		}
4579		targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1);
	4687	while (*targetName == ':') {
	4688	targetName++;
	4689	len--;
	4690	}
	4691	targetNameObjPtr = Jim_NewStringObj(interp, targetName, len);
4580	4692	targetCallFrame = interp->topFramePtr;
4581	4693	}
4582	4694	Jim_IncrRefCount(targetNameObjPtr);

4595	4707
4596	4708	/* Cycles are only possible with 'uplevel 0' */
4597	4709	while (1) {
4598		if (strcmp(Jim_String(objPtr), varName) == 0) {
	4710	if (Jim_Length(objPtr) == varnamelen && memcmp(Jim_String(objPtr), varName, varnamelen) == 0) {
4599	4711	Jim_SetResultString(interp, "can't upvar from variable to itself", -1);
4600	4712	Jim_DecrRefCount(interp, targetNameObjPtr);
4601	4713	return JIM_ERR;

4629	4741	*/
4630	4742	Jim_Obj Jim_GetVariable(Jim_Interp interp, Jim_Obj *nameObjPtr, int flags)
4631	4743	{
	4744	if (interp->safeexpr) {
	4745	return nameObjPtr;
	4746	}
4632	4747	switch (SetVariableFromAny(interp, nameObjPtr)) {
4633	4748	case JIM_OK:{
4634	4749	Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr;

4726	4841	interp->framePtr = framePtr;
4727	4842	}
4728	4843	else {
4729		const char *name = Jim_String(nameObjPtr);
4730	4844	if (nameObjPtr->internalRep.varValue.global) {
4731		name += 2;
	4845	int len;
	4846	const char *name = Jim_GetString(nameObjPtr, &len);
	4847	while (*name == ':') {
	4848	name++;
	4849	len--;
	4850	}
4732	4851	framePtr = interp->topFramePtr;
	4852	Jim_Obj *tempObj = Jim_NewStringObj(interp, name, len);
	4853	retval = JimUnsetVariable(&framePtr->vars, tempObj);
	4854	Jim_FreeNewObj(interp, tempObj);
4733	4855	}
4734	4856	else {
4735	4857	framePtr = interp->framePtr;
4736		}
4737
4738		retval = Jim_DeleteHashEntry(&framePtr->vars, name);
	4858	retval = JimUnsetVariable(&framePtr->vars, nameObjPtr);
	4859	}
	4860
4739	4861	if (retval == JIM_OK) {
4740	4862	/* Change the callframe id, invalidating var lookup caching */
4741	4863	framePtr->id = interp->callFrameEpoch++;

4913	5035	Jim_Obj *resObjPtr = NULL;
4914	5036	Jim_Obj *substKeyObjPtr = NULL;
4915	5037
	5038	if (interp->safeexpr) {
	5039	return objPtr;
	5040	}
	5041
4916	5042	SetDictSubstFromAny(interp, objPtr);
4917	5043
4918	5044	if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr,

4974	5100	Jim_Obj *cmdNameObj;
4975	5101
4976	5102	while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) {
4977		Jim_HashEntry *he;
4978		Jim_Obj *fqObjName;
4979	5103	Jim_HashTable *ht = &interp->commands;
4980
4981		const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName);
4982
4983		he = Jim_FindHashEntry(ht, fqname);
4984
	5104	Jim_HashEntry *he = Jim_FindHashEntry(ht, cmdNameObj);
4985	5105	if (he) {
4986	5106	Jim_Cmd *cmd = Jim_GetHashEntryVal(he);
4987	5107	if (cmd->prevCmd) {

4995	5115	Jim_SetHashVal(ht, he, prevCmd);
4996	5116	}
4997	5117	else {
4998		Jim_DeleteHashEntry(ht, fqname);
4999		}
5000		Jim_InterpIncrProcEpoch(interp);
	5118	Jim_DeleteHashEntry(ht, cmdNameObj);
	5119	}
5001	5120	}
5002	5121	Jim_DecrRefCount(interp, cmdNameObj);
5003		JimFreeQualifiedName(interp, fqObjName);
5004	5122	}
5005	5123	Jim_FreeStack(localCommands);
5006	5124	Jim_Free(localCommands);

5020	5138	Jim_Obj *objPtr;
5021	5139
5022	5140	/* Fast check for the likely case that the variable doesn't exist */
5023		if (Jim_FindHashEntry(&interp->framePtr->vars, "jim::defer") == NULL) {
	5141	if (JimFindVariable(&interp->framePtr->vars, interp->defer) == NULL) {
5024	5142	return retcode;
5025	5143	}
5026
5027		objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
	5144	objPtr = Jim_GetVariable(interp, interp->defer, JIM_NONE);
5028	5145
5029	5146	if (objPtr) {
5030	5147	int ret = JIM_OK;

5079	5196	if (action == JIM_FCF_FULL \|\| cf->vars.size != JIM_HT_INITIAL_SIZE)
5080	5197	Jim_FreeHashTable(&cf->vars);
5081	5198	else {
5082		int i;
5083		Jim_HashEntry *table = cf->vars.table, he;
5084
5085		for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) {
5086		he = table[i];
5087		while (he != NULL) {
5088		Jim_HashEntry *nextEntry = he->next;
5089		Jim_Var *varPtr = Jim_GetHashEntryVal(he);
5090
5091		Jim_DecrRefCount(interp, varPtr->objPtr);
5092		Jim_Free(Jim_GetHashEntryKey(he));
5093		Jim_Free(varPtr);
5094		Jim_Free(he);
5095		table[i] = NULL;
5096		he = nextEntry;
5097		}
5098		}
5099		cf->vars.used = 0;
	5199	Jim_ClearHashTable(&cf->vars);
5100	5200	}
5101	5201	cf->next = interp->freeFramesList;
5102	5202	interp->freeFramesList = cf;

5404	5504	objPtr = objPtr->nextObjPtr;
5405	5505	continue;
5406	5506	}
	5507
	5508	/* If the string is ::<reference we need to skip over the :: when doing the
	5509	* comparison
	5510	*/
	5511	if (str[0] == ':' && str[1] == ':') {
	5512	str +=2;
	5513	len -= 2;
	5514	}
	5515
5407	5516	/* Extract references from the object string repr. */
5408	5517	while (1) {
5409	5518	int i;

5424	5533
5425	5534	/* Ok, a reference for the given ID
5426	5535	* was found. Mark it. */
5427		Jim_AddHashEntry(&marks, &id, NULL);
	5536
	5537	/* But if this is a command in the command table with refCount 1
	5538	* don't mark it since it can be deleted.
	5539	*/
	5540	if (p == str && objPtr->refCount == 1 && Jim_FindHashEntry(&interp->commands, objPtr)) {
5428	5541	#ifdef JIM_DEBUG_GC
5429		printf("MARK: %d\n", (int)id);
	5542	printf("No MARK: %lu - command with refcount=1\n", id);
	5543	#endif
	5544	break;
	5545	}
	5546	Jim_AddHashEntry(&marks, &id, objPtr);
	5547	#ifdef JIM_DEBUG_GC
	5548	printf("MARK: %lu (type=%s)\n", id, JimObjTypeName(objPtr));
5430	5549	#endif
5431	5550	p += JIM_REFERENCE_SPACE;
5432	5551	}

5483	5602	}
5484	5603	Jim_FreeHashTable(&marks);
5485	5604	interp->lastCollectId = interp->referenceNextId;
5486		interp->lastCollectTime = time(NULL);
	5605	interp->lastCollectTime = JimClock();
5487	5606	return collected;
5488	5607	}
5489	5608
5490		#define JIM_COLLECT_ID_PERIOD 5000
5491		#define JIM_COLLECT_TIME_PERIOD 300
	5609	#define JIM_COLLECT_ID_PERIOD 5000000
	5610	#define JIM_COLLECT_TIME_PERIOD 300000
5492	5611
5493	5612	void Jim_CollectIfNeeded(Jim_Interp *interp)
5494	5613	{
5495	5614	unsigned long elapsedId;
5496		int elapsedTime;
	5615	jim_wide elapsedTime;
5497	5616
5498	5617	elapsedId = interp->referenceNextId - interp->lastCollectId;
5499		elapsedTime = time(NULL) - interp->lastCollectTime;
	5618	elapsedTime = JimClock() - interp->lastCollectTime;
5500	5619
5501	5620
5502	5621	if (elapsedId > JIM_COLLECT_ID_PERIOD \|\| elapsedTime > JIM_COLLECT_TIME_PERIOD) {

5527	5646
5528	5647	i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH;
5529	5648	i->maxEvalDepth = JIM_MAX_EVAL_DEPTH;
5530		i->lastCollectTime = time(NULL);
	5649	i->lastCollectTime = JimClock();
5531	5650
5532	5651	/* Note that we can create objects only after the
5533	5652	* interpreter liveList and freeList pointers are

5546	5665	i->result = i->emptyObj;
5547	5666	i->stackTrace = Jim_NewListObj(i, NULL, 0);
5548	5667	i->unknown = Jim_NewStringObj(i, "unknown", -1);
	5668	i->defer = Jim_NewStringObj(i, "jim::defer", -1);
5549	5669	i->errorProc = i->emptyObj;
5550	5670	i->currentScriptObj = Jim_NewEmptyStringObj(i);
5551	5671	i->nullScriptObj = Jim_NewEmptyStringObj(i);

5554	5674	Jim_IncrRefCount(i->result);
5555	5675	Jim_IncrRefCount(i->stackTrace);
5556	5676	Jim_IncrRefCount(i->unknown);
	5677	Jim_IncrRefCount(i->defer);
5557	5678	Jim_IncrRefCount(i->currentScriptObj);
5558	5679	Jim_IncrRefCount(i->nullScriptObj);
5559	5680	Jim_IncrRefCount(i->errorProc);

5570	5691	Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
5571	5692	Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian");
5572	5693	Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
	5694	Jim_SetVariableStrWithStr(i, "tcl_platform(bootstrap)", "0");
5573	5695	Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
5574	5696	Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));
5575	5697

5581	5703	Jim_CallFrame cf, cfx;
5582	5704
5583	5705	Jim_Obj objPtr, nextObjPtr;
	5706
	5707	i->quitting = 1;
5584	5708
5585	5709	/* Free the active call frames list - must be done before i->commands is destroyed */
5586	5710	for (cf = i->framePtr; cf; cf = cfx) {

5597	5721	Jim_DecrRefCount(i, i->stackTrace);
5598	5722	Jim_DecrRefCount(i, i->errorProc);
5599	5723	Jim_DecrRefCount(i, i->unknown);
	5724	Jim_DecrRefCount(i, i->defer);
5600	5725	Jim_DecrRefCount(i, i->errorFileNameObj);
5601	5726	Jim_DecrRefCount(i, i->currentScriptObj);
5602	5727	Jim_DecrRefCount(i, i->nullScriptObj);
	5728
	5729	Jim_InterpIncrProcEpoch(i);
	5730
5603	5731	Jim_FreeHashTable(&i->commands);
5604	5732	#ifdef JIM_REFERENCES
5605	5733	Jim_FreeHashTable(&i->references);

5607	5735	Jim_FreeHashTable(&i->packages);
5608	5736	Jim_Free(i->prngState);
5609	5737	Jim_FreeHashTable(&i->assocData);
	5738	if (i->traceCmdObj) {
	5739	Jim_DecrRefCount(i, i->traceCmdObj);
	5740	}
5610	5741
5611	5742	/* Check that the live object list is empty, otherwise
5612	5743	* there is a memory leak. */

5963	6094	return JIM_OK;
5964	6095	}
5965	6096
	6097	int Jim_GetWideExpr(Jim_Interp interp, Jim_Obj objPtr, jim_wide * widePtr)
	6098	{
	6099	int ret = JIM_OK;
	6100	if (objPtr->typePtr == &intObjType) {
	6101	*widePtr = JimWideValue(objPtr);
	6102	}
	6103	else {
	6104	/* safeexpr can never be set here, because evaluating an expression
	6105	* safely can never cause a script to be run
	6106	*/
	6107	JimPanic((interp->safeexpr, "interp->safeexpr is set"));
	6108	interp->safeexpr++;
	6109	ret = Jim_EvalExpression(interp, objPtr);
	6110	interp->safeexpr--;
	6111
	6112	if (ret == JIM_OK) {
	6113	ret = Jim_GetWide(interp, Jim_GetResult(interp), widePtr);
	6114	}
	6115	if (ret != JIM_OK) {
	6116	/* XXX By doing this we throw away any more detailed message,
	6117	* but typical integer expressions won't be very complex
	6118	*/
	6119	Jim_SetResultFormatted(interp, "expected integer expression but got \"%#s\"", objPtr);
	6120	}
	6121	}
	6122	return ret;
	6123	}
	6124
5966	6125	/* Get a wide but does not set an error if the format is bad. */
5967	6126	static int JimGetWideNoErr(Jim_Interp interp, Jim_Obj objPtr, jim_wide * widePtr)
5968	6127	{

6157	6316	return JIM_OK;
6158	6317	}
6159	6318
	6319	static const char * const jim_true_false_strings[8] = {
	6320	"1", "true", "yes", "on",
	6321	"0", "false", "no", "off"
	6322	};
	6323	/* Must keep these lengths in sync with the strings above */
	6324	static const int jim_true_false_lens[8] = {
	6325	1, 4, 3, 2,
	6326	1, 5, 2, 3,
	6327	};
	6328
6160	6329	static int SetBooleanFromAny(Jim_Interp interp, Jim_Obj objPtr, int flags)
6161	6330	{
6162		static const char * const falses[] = {
6163		"0", "false", "no", "off", NULL
6164		};
6165		static const char * const trues[] = {
6166		"1", "true", "yes", "on", NULL
6167		};
6168
6169		int boolean;
6170
6171		int index;
6172		if (Jim_GetEnum(interp, objPtr, falses, &index, NULL, 0) == JIM_OK) {
6173		boolean = 0;
6174		} else if (Jim_GetEnum(interp, objPtr, trues, &index, NULL, 0) == JIM_OK) {
6175		boolean = 1;
6176		} else {
	6331	int index = Jim_FindByName(Jim_String(objPtr), jim_true_false_strings,
	6332	sizeof(jim_true_false_strings) / sizeof(*jim_true_false_strings));
	6333	if (index < 0) {
6177	6334	if (flags & JIM_ERRMSG) {
6178	6335	Jim_SetResultFormatted(interp, "expected boolean but got \"%#s\"", objPtr);
6179	6336	}

6183	6340	/* Free the old internal repr and set the new one. */
6184	6341	Jim_FreeIntRep(interp, objPtr);
6185	6342	objPtr->typePtr = &intObjType;
6186		objPtr->internalRep.wideValue = boolean;
	6343	/* 4 true values in jim_true_false_strings */
	6344	objPtr->internalRep.wideValue = index < 4 ? 1 : 0;
6187	6345	return JIM_OK;
6188	6346	}
6189	6347

6498	6656	return JIM_OK;
6499	6657	}
6500	6658
6501		/* Optimise dict -> list for object with no string rep. Note that this may only save a little time, but
6502		* it also preserves any source location of the dict elements
6503		* which can be very useful
6504		*/
	6659	/* Optimise dict -> list for object with no string rep. */
6505	6660	if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) {
6506		Jim_Obj **listObjPtrPtr;
6507		int len;
6508		int i;
6509
6510		listObjPtrPtr = JimDictPairs(objPtr, &len);
6511		for (i = 0; i < len; i++) {
6512		Jim_IncrRefCount(listObjPtrPtr[i]);
6513		}
6514
6515		/* Now just switch the internal rep */
6516		Jim_FreeIntRep(interp, objPtr);
	6661	Jim_Dict *dict = objPtr->internalRep.dictValue;
	6662	/* To convert to a list we need to:
	6663	* 1. Take ownership of the table
	6664	* 2. Discard the hash table
	6665	* 3. Free the dict structure
	6666	*/
	6667
	6668	/* 1. Switch the internal rep */
6517	6669	objPtr->typePtr = &listObjType;
6518		objPtr->internalRep.listValue.len = len;
6519		objPtr->internalRep.listValue.maxLen = len;
6520		objPtr->internalRep.listValue.ele = listObjPtrPtr;
6521
	6670	objPtr->internalRep.listValue.len = dict->len;
	6671	objPtr->internalRep.listValue.maxLen = dict->maxLen;
	6672	objPtr->internalRep.listValue.ele = dict->table;
	6673
	6674	/* 2. Discard the hash table */
	6675	Jim_Free(dict->ht);
	6676
	6677	/* 3. Free the dict structure */
	6678	Jim_Free(dict);
6522	6679	return JIM_OK;
6523	6680	}
6524	6681

6585	6742	* sure that the list object can't shimmer while the vector returned
6586	6743	* is in use, this vector is the one stored inside the internal representation
6587	6744	* of the list object. This function is not exported, extensions should
6588		* always access to the List object elements using Jim_ListIndex(). */
	6745	* always access to the List object elements using Jim_ListGetIndex(). */
6589	6746	static void JimListGetElements(Jim_Interp interp, Jim_Obj listObj, int *listLen,
6590	6747	Jim_Obj ***listVec)
6591	6748	{

6618	6775	JIM_LSORT_COMMAND
6619	6776	} type;
6620	6777	int order;
6621		int index;
6622		int indexed;
	6778	Jim_Obj **indexv;
	6779	int indexc;
6623	6780	int unique;
6624	6781	int (subfn)(Jim_Obj , Jim_Obj *);
6625	6782	};

6630	6787	{
6631	6788	Jim_Obj lObj, rObj;
6632	6789
6633		if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK \|\|
6634		Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) {
	6790	if (Jim_ListIndices(sort_info->interp, *lhsObj, sort_info->indexv, sort_info->indexc, &lObj, JIM_ERRMSG) != JIM_OK \|\|
	6791	Jim_ListIndices(sort_info->interp, *rhsObj, sort_info->indexv, sort_info->indexc, &rObj, JIM_ERRMSG) != JIM_OK) {
6635	6792	longjmp(sort_info->jmpbuf, JIM_ERR);
6636	6793	}
6637	6794	return sort_info->subfn(&lObj, &rObj);

6773	6930	return -1; /* Should not be run but keeps static analysers happy */
6774	6931	}
6775	6932
6776		if (info->indexed) {
	6933	if (info->indexc) {
6777	6934	/* Need to interpose a "list index" function */
6778	6935	info->subfn = fn;
6779	6936	fn = ListSortIndexHelper;

6791	6948	sort_info = prev_info;
6792	6949
6793	6950	return rc;
	6951	}
	6952
	6953	/* Ensure there is room for at least 'idx' values in the list */
	6954	static void ListEnsureLength(Jim_Obj *listPtr, int idx)
	6955	{
	6956	assert(idx >= 0);
	6957	if (idx >= listPtr->internalRep.listValue.maxLen) {
	6958	if (idx < 4) {
	6959	/* Don't do allocations of under 4 pointers. */
	6960	idx = 4;
	6961	}
	6962	listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
	6963	sizeof(Jim_Obj ) idx);
	6964
	6965	listPtr->internalRep.listValue.maxLen = idx;
	6966	}
6794	6967	}
6795	6968
6796	6969	/* This is the low-level function to insert elements into a list.

6811	6984	Jim_Obj **point;
6812	6985
6813	6986	if (requiredLen > listPtr->internalRep.listValue.maxLen) {
6814		if (requiredLen < 2) {
6815		/* Don't do allocations of under 4 pointers. */
6816		requiredLen = 4;
6817		}
6818		else {
	6987	if (currentLen) {
	6988	/* Assume that we will need extra space for future expansion */
6819	6989	requiredLen *= 2;
6820	6990	}
6821
6822		listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele,
6823		sizeof(Jim_Obj ) requiredLen);
6824
6825		listPtr->internalRep.listValue.maxLen = requiredLen;
	6991	ListEnsureLength(listPtr, requiredLen);
6826	6992	}
6827	6993	if (idx < 0) {
6828	6994	idx = currentLen;

6911	7077	return JIM_ERR;
6912	7078	}
6913	7079	return JIM_OK;
	7080	}
	7081
	7082	/* Get the value from the list associated to the specified list indices.
	7083	* Return JIM_ERR if an index is invalid (and sets an error message).
	7084	* Returns -1 if the list index is out of range.
	7085	* In this case, if flags includes JIM_ERRMSG, an error result is set.
	7086	* Otherwise, returns JIM_OK and sets *resultObj to the indexed value.
	7087	* (This is the only case where *resultObj is set)
	7088	*/
	7089	static int Jim_ListIndices(Jim_Interp interp, Jim_Obj listPtr,
	7090	Jim_Obj const indexv, int indexc, Jim_Obj **resultObj, int flags)
	7091	{
	7092	int i;
	7093	int static_idxes[5];
	7094	int *idxes = static_idxes;
	7095	int ret = JIM_OK;
	7096
	7097	if (indexc > sizeof(static_idxes) / sizeof(*static_idxes)) {
	7098	idxes = Jim_Alloc(indexc * sizeof(*idxes));
	7099	}
	7100
	7101	/* In the rare, contrived case where an index is also the list (or an element)
	7102	* we need to extract the indices first.
	7103	*/
	7104	for (i = 0; i < indexc; i++) {
	7105	ret = Jim_GetIndex(interp, indexv[i], &idxes[i]);
	7106	if (ret != JIM_OK) {
	7107	goto err;
	7108	}
	7109	}
	7110
	7111	for (i = 0; i < indexc; i++) {
	7112	Jim_Obj *objPtr = Jim_ListGetIndex(interp, listPtr, idxes[i]);
	7113	if (!objPtr) {
	7114	if (flags & JIM_ERRMSG) {
	7115	if (idxes[i] < 0 \|\| idxes[i] > Jim_ListLength(interp, listPtr)) {
	7116	Jim_SetResultFormatted(interp, "index \"%#s\" out of range", indexv[i]);
	7117	}
	7118	else {
	7119	Jim_SetResultFormatted(interp, "element %#s missing from sublist \"%#s\"", indexv[i], listPtr);
	7120	}
	7121	}
	7122	return -1;
	7123	}
	7124	listPtr = objPtr;
	7125	}
	7126	*resultObj = listPtr;
	7127	err:
	7128	if (idxes != static_idxes)
	7129	Jim_Free(idxes);
	7130	return ret;
6914	7131	}
6915	7132
6916	7133	static int ListSetIndex(Jim_Interp interp, Jim_Obj listPtr, int idx,

6950	7167	listObjPtr = objPtr;
6951	7168	if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK)
6952	7169	goto err;
6953		if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) {
	7170
	7171	objPtr = Jim_ListGetIndex(interp, listObjPtr, idx);
	7172	if (objPtr == NULL) {
	7173	Jim_SetResultFormatted(interp, "index \"%#s\" out of range", indexv[i]);
6954	7174	goto err;
6955	7175	}
6956	7176	if (Jim_IsShared(objPtr)) {

7087	7307	static void UpdateStringOfDict(struct Jim_Obj *objPtr);
7088	7308	static int SetDictFromAny(Jim_Interp interp, struct Jim_Obj objPtr);
7089	7309
7090		/* Dict HashTable Type.
	7310	/* Dict Type.
7091	7311	*
7092		* Keys and Values are Jim objects. */
7093
7094		static unsigned int JimObjectHTHashFunction(const void *key)
7095		{
7096		int len;
7097		const char str = Jim_GetString((Jim_Obj )key, &len);
7098		return Jim_GenHashFunction((const unsigned char *)str, len);
7099		}
7100
7101		static int JimObjectHTKeyCompare(void privdata, const void key1, const void *key2)
7102		{
7103		return Jim_StringEqObj((Jim_Obj )key1, (Jim_Obj )key2);
7104		}
7105
7106		static void JimObjectHTKeyValDup(void privdata, const void *val)
7107		{
7108		Jim_IncrRefCount((Jim_Obj *)val);
7109		return (void *)val;
7110		}
7111
7112		static void JimObjectHTKeyValDestructor(void interp, void val)
7113		{
7114		Jim_DecrRefCount(interp, (Jim_Obj *)val);
7115		}
7116
7117		static const Jim_HashTableType JimDictHashTableType = {
7118		JimObjectHTHashFunction, /* hash function */
7119		JimObjectHTKeyValDup, /* key dup */
7120		JimObjectHTKeyValDup, /* val dup */
7121		JimObjectHTKeyCompare, /* key compare */
7122		JimObjectHTKeyValDestructor, /* key destructor */
7123		JimObjectHTKeyValDestructor /* val destructor */
7124		};
	7312	* Jim dictionaries use a specialised hash table for efficiency.
	7313	* See Jim_Dict in jim.h
	7314	*/
7125	7315
7126	7316	/* Note that while the elements of the dict may contain references,
7127	7317	* the list object itself can't. This basically means that the

7135	7325	JIM_TYPE_NONE,
7136	7326	};
7137	7327
7138		void FreeDictInternalRep(Jim_Interp interp, Jim_Obj objPtr)
7139		{
7140		JIM_NOTUSED(interp);
7141
7142		Jim_FreeHashTable(objPtr->internalRep.ptr);
7143		Jim_Free(objPtr->internalRep.ptr);
7144		}
7145
7146		void DupDictInternalRep(Jim_Interp interp, Jim_Obj srcPtr, Jim_Obj *dupPtr)
7147		{
7148		Jim_HashTable ht, dupHt;
7149		Jim_HashTableIterator htiter;
7150		Jim_HashEntry *he;
	7328	/**
	7329	* Free the entire dict structure, including the key, value table,
	7330	* the hash table and the dict structure.
	7331	*/
	7332	static void JimFreeDict(Jim_Interp interp, Jim_Dict dict)
	7333	{
	7334	int i;
	7335	for (i = 0; i < dict->len; i++) {
	7336	Jim_DecrRefCount(interp, dict->table[i]);
	7337	}
	7338	Jim_Free(dict->table);
	7339	Jim_Free(dict->ht);
	7340	Jim_Free(dict);
	7341	}
	7342
	7343	enum {
	7344	DICT_HASH_FIND = -1,
	7345	DICT_HASH_REMOVE = -2,
	7346	DICT_HASH_ADD = -3,
	7347	};
	7348
	7349	/**
	7350	* Search for the given key in the dict hash table and perform the given operation.
	7351	*
	7352	* op_tvoffset is one of:
	7353	*
	7354	* DICT_HASH_FIND
	7355	* - if found, returns the table value offset, otherwise 0
	7356	* DICT_HASH_REMOVE
	7357	* - if found, removes the entry and returns the table value offset, otherwise 0
	7358	* DICT_HASH_ADD
	7359	* - if found, does nothing and returns the table value offset.
	7360	* otherwise adds the entry with a table value offset of dict->len + 1 and returns 0
	7361	* A table value offset (> 0)
	7362	* - in this case the entry must exist and the table value offset
	7363	* for the entry is updated to be op_offset.
	7364	*/
	7365	static int JimDictHashFind(Jim_Dict dict, Jim_Obj keyObjPtr, int op_tvoffset)
	7366	{
	7367	unsigned h = (JimObjectHTHashFunction(keyObjPtr) + dict->uniq);
	7368	unsigned idx = h & dict->sizemask;
	7369	int tvoffset = 0;
	7370	unsigned peturb = h;
	7371
	7372	if (dict->len) {
	7373	while ((tvoffset = dict->ht[idx].offset)) {
	7374	if (tvoffset == -1) {
	7375	/* An entry with offset=-1 is a removed entry
	7376	* we need skip it when searching, but stop when adding.
	7377	*/
	7378	if (op_tvoffset == DICT_HASH_ADD) {
	7379	tvoffset = 0;
	7380	break;
	7381	}
	7382	}
	7383	else if (dict->ht[idx].hash == h) {
	7384	if (Jim_StringEqObj(keyObjPtr, dict->table[tvoffset - 1])) {
	7385	break;
	7386	}
	7387	}
	7388	/* Use the Python algorithm for conflict resolution */
	7389	peturb >>= 5;
	7390	idx = (5 * idx + 1 + peturb) & dict->sizemask;
	7391	}
	7392	}
	7393
	7394	switch (op_tvoffset) {
	7395	case DICT_HASH_FIND:
	7396	/* If found return tvoffset, if not found return 0 */
	7397	break;
	7398	case DICT_HASH_REMOVE:
	7399	if (tvoffset) {
	7400	/* Found, remove with -1 meaning a removed entry */
	7401	dict->ht[idx].offset = -1;
	7402	}
	7403	/* else if not found, return 0 */
	7404	break;
	7405	case DICT_HASH_ADD:
	7406	if (tvoffset == 0) {
	7407	/* Not found so add it at the end */
	7408	dict->ht[idx].offset = dict->len + 1;
	7409	dict->ht[idx].hash = h;
	7410	}
	7411	/* else if found, return tvoffset */
	7412	break;
	7413	default:
	7414	assert(tvoffset);
	7415	/* Found so replace the tvoffset */
	7416	dict->ht[idx].offset = op_tvoffset;
	7417	break;
	7418	}
	7419
	7420	return tvoffset;
	7421	}
	7422
	7423	/* Expand or create the hashtable to at least size 'size'
	7424	* The hash table size should have room for twice the number
	7425	* of keys to reduce collisions
	7426	*/
	7427	static void JimDictExpandHashTable(Jim_Dict *dict, unsigned int size)
	7428	{
	7429	int i;
	7430	struct JimDictHashEntry *prevht = dict->ht;
	7431	int prevsize = dict->size;
	7432
	7433	dict->size = JimHashTableNextPower(size);
	7434	dict->sizemask = dict->size - 1;
	7435
	7436	/* Allocate a new table so that we don't need to recalulate hashes */
	7437	dict->ht = Jim_Alloc(dict->size * sizeof(*dict->ht));
	7438	memset(dict->ht, 0, dict->size * sizeof(*dict->ht));
	7439
	7440	/* Now add all the table entries to the new table */
	7441	for (i = 0; i < prevsize; i++) {
	7442	if (prevht[i].offset > 0) {
	7443	/* Find the location in the new table for this entry */
	7444	unsigned h = prevht[i].hash;
	7445	unsigned idx = h & dict->sizemask;
	7446	unsigned peturb = h;
	7447
	7448	while (dict->ht[idx].offset) {
	7449	peturb >>= 5;
	7450	idx = (5 * idx + 1 + peturb) & dict->sizemask;
	7451	}
	7452	dict->ht[idx].offset = prevht[i].offset;
	7453	dict->ht[idx].hash = h;
	7454	}
	7455	}
	7456	Jim_Free(prevht);
	7457	}
	7458
	7459	/**
	7460	* Add an entry to the hash table for 'keyObjPtr'
	7461	* If the entry already exists, returns the current tvoffset.
	7462	* Otherwise inserts a new entry with table value offset dict->len + 1
	7463	* and returns 0.
	7464	*/
	7465	static int JimDictAdd(Jim_Dict dict, Jim_Obj keyObjPtr)
	7466	{
	7467	/* If we are trying to add an entry and the hash table is too small,
	7468	* increase the size now, even if it may exist and the add would
	7469	* do nothing.
	7470	* This way we don't need to recalculate the hash index in case
	7471	* it didn't exist and is added.
	7472	*/
	7473	if (dict->size <= dict->len) {
	7474	/* The first add grows the size to 8, and thereafter it is doubled
	7475	* in size. Note that hash table sizes are always powers of two.
	7476	*/
	7477	JimDictExpandHashTable(dict, dict->size ? dict->size * 2 : 8);
	7478	}
	7479	return JimDictHashFind(dict, keyObjPtr, DICT_HASH_ADD);
	7480	}
	7481
	7482	/**
	7483	* Allocate and return a new Jim_Dict structure
	7484	* with space for 'table_size' (key, object) entries
	7485	* and hash table size 'ht_size'
	7486	* These can be 0.
	7487	*/
	7488	static Jim_Dict JimDictNew(Jim_Interp interp, int table_size, int ht_size)
	7489	{
	7490	Jim_Dict dict = Jim_Alloc(sizeof(dict));
	7491	memset(dict, 0, sizeof(*dict));
	7492
	7493	if (ht_size) {
	7494	JimDictExpandHashTable(dict, ht_size);
	7495	}
	7496	if (table_size) {
	7497	dict->table = Jim_Alloc(table_size * sizeof(*dict->table));
	7498	dict->maxLen = table_size;
	7499	}
	7500	#ifdef JIM_RANDOMISE_HASH
	7501	/* This is initialised to a random value to avoid a hash collision attack.
	7502	* See: n.runs-SA-2011.004
	7503	*/
	7504	dict->uniq = (rand() ^ time(NULL) ^ clock());
	7505	#endif
	7506	return dict;
	7507	}
	7508
	7509	static void FreeDictInternalRep(Jim_Interp interp, Jim_Obj objPtr)
	7510	{
	7511	JimFreeDict(interp, objPtr->internalRep.dictValue);
	7512	}
	7513
	7514	static void DupDictInternalRep(Jim_Interp interp, Jim_Obj srcPtr, Jim_Obj *dupPtr)
	7515	{
	7516	Jim_Dict *oldDict = srcPtr->internalRep.dictValue;
	7517	int i;
7151	7518
7152	7519	/* Create a new hash table */
7153		ht = srcPtr->internalRep.ptr;
7154		dupHt = Jim_Alloc(sizeof(*dupHt));
7155		Jim_InitHashTable(dupHt, &JimDictHashTableType, interp);
7156		if (ht->size != 0)
7157		Jim_ExpandHashTable(dupHt, ht->size);
7158		/* Copy every element from the source to the dup hash table */
7159		JimInitHashTableIterator(ht, &htiter);
7160		while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7161		Jim_AddHashEntry(dupHt, he->key, he->u.val);
7162		}
7163
7164		dupPtr->internalRep.ptr = dupHt;
	7520	Jim_Dict *newDict = JimDictNew(interp, oldDict->maxLen, oldDict->size);
	7521
	7522	/* Copy the table of key and value objects, incrementing the reference count of both */
	7523	for (i = 0; i < oldDict->len; i++) {
	7524	newDict->table[i] = oldDict->table[i];
	7525	Jim_IncrRefCount(newDict->table[i]);
	7526	}
	7527	newDict->len = oldDict->len;
	7528
	7529	/* Must keep the same uniq so that the hashes agree */
	7530	newDict->uniq = oldDict->uniq;
	7531
	7532	/* Now copy the the hash table efficiently */
	7533	memcpy(newDict->ht, oldDict->ht, sizeof(oldDict->ht) oldDict->size);
	7534
	7535	dupPtr->internalRep.dictValue = newDict;
7165	7536	dupPtr->typePtr = &dictObjType;
7166	7537	}
7167	7538
7168		static Jim_Obj *JimDictPairs(Jim_Obj dictPtr, int *len)
7169		{
7170		Jim_HashTable *ht;
7171		Jim_HashTableIterator htiter;
7172		Jim_HashEntry *he;
7173		Jim_Obj **objv;
7174		int i;
7175
7176		ht = dictPtr->internalRep.ptr;
7177
7178		/* Turn the hash table into a flat vector of Jim_Objects. */
7179		objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *));
7180		JimInitHashTableIterator(ht, &htiter);
7181		i = 0;
7182		while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
7183		objv[i++] = Jim_GetHashEntryKey(he);
7184		objv[i++] = Jim_GetHashEntryVal(he);
7185		}
7186		*len = i;
7187		return objv;
7188		}
7189
7190	7539	static void UpdateStringOfDict(struct Jim_Obj *objPtr)
7191	7540	{
7192		/* Turn the hash table into a flat vector of Jim_Objects. */
7193		int len;
7194		Jim_Obj **objv = JimDictPairs(objPtr, &len);
7195
7196		/* And now generate the string rep as a list */
7197		JimMakeListStringRep(objPtr, objv, len);
7198
7199		Jim_Free(objv);
	7541	JimMakeListStringRep(objPtr, objPtr->internalRep.dictValue->table, objPtr->internalRep.dictValue->len);
7200	7542	}
7201	7543
7202	7544	static int SetDictFromAny(Jim_Interp interp, struct Jim_Obj objPtr)

7209	7551
7210	7552	if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) {
7211	7553	/* A shared list, so get the string representation now to avoid
7212		* changing the order in case of fast conversion to dict.
	7554	* losing duplicate keys from the string rep when converting to
	7555	* a dict.
7213	7556	*/
7214	7557	Jim_String(objPtr);
7215	7558	}
7216	7559
7217		/* For simplicity, convert a non-list object to a list and then to a dict */
	7560	/* Convert a non-list object to a list and then to a dict
	7561	* since we will need the list of key, value pairs anyway
	7562	*/
7218	7563	listlen = Jim_ListLength(interp, objPtr);
7219	7564	if (listlen % 2) {
7220	7565	Jim_SetResultString(interp, "missing value to go with key", -1);
7221	7566	return JIM_ERR;
7222	7567	}
7223	7568	else {
7224		/* Converting from a list to a dict can't fail */
7225		Jim_HashTable *ht;
	7569	/* Allocate space in the hash table for twice the number of elements */
	7570	Jim_Dict *dict = JimDictNew(interp, 0, listlen);
7226	7571	int i;
7227	7572
7228		ht = Jim_Alloc(sizeof(*ht));
7229		Jim_InitHashTable(ht, &JimDictHashTableType, interp);
7230
	7573	/* Take ownership of the list array */
	7574	dict->table = objPtr->internalRep.listValue.ele;
	7575	dict->maxLen = objPtr->internalRep.listValue.maxLen;
	7576
	7577	/* Now add all the elements to the hash table */
7231	7578	for (i = 0; i < listlen; i += 2) {
7232		Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i);
7233		Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1);
7234
7235		Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr);
7236		}
7237
7238		Jim_FreeIntRep(interp, objPtr);
	7579	int tvoffset = JimDictAdd(dict, dict->table[i]);
	7580	if (tvoffset) {
	7581	/* A duplicate key, so replace the value but and don't add a new entry */
	7582	/* Discard the old value */
	7583	Jim_DecrRefCount(interp, dict->table[tvoffset]);
	7584	/* Set the new value */
	7585	dict->table[tvoffset] = dict->table[i + 1];
	7586	/* Discard the duplicate key */
	7587	Jim_DecrRefCount(interp, dict->table[i]);
	7588	}
	7589	else {
	7590	if (dict->len != i) {
	7591	/* Need to move later entries down to fill the hole created by
	7592	* a previous duplicate entry.
	7593	*/
	7594	dict->table[dict->len++] = dict->table[i];
	7595	dict->table[dict->len++] = dict->table[i + 1];
	7596	}
	7597	else {
	7598	dict->len += 2;
	7599	}
	7600	}
	7601	}
	7602
7239	7603	objPtr->typePtr = &dictObjType;
7240		objPtr->internalRep.ptr = ht;
	7604	objPtr->internalRep.dictValue = dict;
7241	7605
7242	7606	return JIM_OK;
7243	7607	}

7254	7618	static int DictAddElement(Jim_Interp interp, Jim_Obj objPtr,
7255	7619	Jim_Obj keyObjPtr, Jim_Obj valueObjPtr)
7256	7620	{
7257		Jim_HashTable *ht = objPtr->internalRep.ptr;
7258
7259		if (valueObjPtr == NULL) { /* unset */
7260		return Jim_DeleteHashEntry(ht, keyObjPtr);
7261		}
7262		Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr);
7263		return JIM_OK;
	7621	Jim_Dict *dict = objPtr->internalRep.dictValue;
	7622	if (valueObjPtr == NULL) {
	7623	/* Removing an entry */
	7624	int tvoffset = JimDictHashFind(dict, keyObjPtr, DICT_HASH_REMOVE);
	7625	if (tvoffset) {
	7626	/* Found, so we need to remove the value from the table too, and if it is not the last
	7627	* entry, need to swap with the last entry
	7628	*/
	7629	/* Remove the table entries */
	7630	Jim_DecrRefCount(interp, dict->table[tvoffset - 1]);
	7631	Jim_DecrRefCount(interp, dict->table[tvoffset]);
	7632	dict->len -= 2;
	7633	if (tvoffset != dict->len + 1) {
	7634	/* Swap the last pair of table entries into the now empty entries */
	7635	dict->table[tvoffset - 1] = dict->table[dict->len];
	7636	dict->table[tvoffset] = dict->table[dict->len + 1];
	7637
	7638	/* Now we need to update the hash table for the swapped entry */
	7639	JimDictHashFind(dict, dict->table[tvoffset - 1], tvoffset);
	7640	}
	7641	return JIM_OK;
	7642	}
	7643	return JIM_ERR;
	7644	}
	7645	else {
	7646	/* Adding an entry - does it already exist? */
	7647	int tvoffset = JimDictAdd(dict, keyObjPtr);
	7648	if (tvoffset) {
	7649	/* Yes, already exists, so just replace value entry in the table */
	7650	Jim_IncrRefCount(valueObjPtr);
	7651	Jim_DecrRefCount(interp, dict->table[tvoffset]);
	7652	dict->table[tvoffset] = valueObjPtr;
	7653	}
	7654	else {
	7655	/* No, so need to make space in the table
	7656	* and insert this entry at dict->len, dict->len + 1
	7657	*/
	7658	if (dict->maxLen == dict->len) {
	7659	/* Expand the table */
	7660	if (dict->maxLen < 4) {
	7661	dict->maxLen = 4;
	7662	}
	7663	else {
	7664	dict->maxLen *= 2;
	7665	}
	7666	dict->table = Jim_Realloc(dict->table, dict->maxLen * sizeof(*dict->table));
	7667	}
	7668	Jim_IncrRefCount(keyObjPtr);
	7669	Jim_IncrRefCount(valueObjPtr);
	7670
	7671	dict->table[dict->len++] = keyObjPtr;
	7672	dict->table[dict->len++] = valueObjPtr;
	7673
	7674	}
	7675	return JIM_OK;
	7676	}
7264	7677	}
7265	7678
7266	7679	/* Add an element, higher-level interface for DictAddElement().

7286	7699	objPtr = Jim_NewObj(interp);
7287	7700	objPtr->typePtr = &dictObjType;
7288	7701	objPtr->bytes = NULL;
7289		objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable));
7290		Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp);
	7702
	7703	objPtr->internalRep.dictValue = JimDictNew(interp, len, len);
7291	7704	for (i = 0; i < len; i += 2)
7292	7705	DictAddElement(interp, objPtr, elements[i], elements[i + 1]);
7293	7706	return objPtr;

7301	7714	int Jim_DictKey(Jim_Interp interp, Jim_Obj dictPtr, Jim_Obj *keyPtr,
7302	7715	Jim_Obj **objPtrPtr, int flags)
7303	7716	{
7304		Jim_HashEntry *he;
7305		Jim_HashTable *ht;
	7717	int tvoffset;
	7718	Jim_Dict *dict;
7306	7719
7307	7720	if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7308	7721	return -1;
7309	7722	}
7310		ht = dictPtr->internalRep.ptr;
7311		if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) {
	7723	dict = dictPtr->internalRep.dictValue;
	7724	tvoffset = JimDictHashFind(dict, keyPtr, DICT_HASH_FIND);
	7725	if (tvoffset == 0) {
7312	7726	if (flags & JIM_ERRMSG) {
7313	7727	Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr);
7314	7728	}
7315	7729	return JIM_ERR;
7316	7730	}
7317		else {
7318		*objPtrPtr = Jim_GetHashEntryVal(he);
7319		return JIM_OK;
7320		}
7321		}
7322
7323		/* Return an allocated array of key/value pairs for the dictionary. Stores the length in len /
7324		int Jim_DictPairs(Jim_Interp interp, Jim_Obj dictPtr, Jim_Obj **objPtrPtr, int len)
7325		{
	7731	*objPtrPtr = dict->table[tvoffset];
	7732	return JIM_OK;
	7733	}
	7734
	7735	/* Return the key/value pairs array for the dictionary. Stores the length in *len
	7736	*
	7737	* Note that the point is to the internal table, so is only
	7738	* valid until the dict is next modified, and the result should
	7739	* not be freed.
	7740	*
	7741	* Returns NULL if the object can't be converted to a dictionary, or if the length is 0.
	7742	*/
	7743	Jim_Obj *Jim_DictPairs(Jim_Interp interp, Jim_Obj dictPtr, int len)
	7744	{
	7745	/* If it is a list with an even number of elements, no need to convert to dict first */
	7746	if (Jim_IsList(dictPtr)) {
	7747	Jim_Obj **table;
	7748	JimListGetElements(interp, dictPtr, len, &table);
	7749	if (*len % 2 == 0) {
	7750	return table;
	7751	}
	7752	/* Otherwise fall through to get the standard error */
	7753	}
7326	7754	if (SetDictFromAny(interp, dictPtr) != JIM_OK) {
7327		return JIM_ERR;
7328		}
7329		*objPtrPtr = JimDictPairs(dictPtr, len);
7330
7331		return JIM_OK;
7332		}
7333
	7755	/* Make sure we can differentiate between an empty dict/list and bad length */
	7756	*len = 1;
	7757	return NULL;
	7758	}
	7759	*len = dictPtr->internalRep.dictValue->len;
	7760	return dictPtr->internalRep.dictValue->table;
	7761	}
7334	7762
7335	7763	/* Return the value associated to the specified dict keys */
7336	7764	int Jim_DictKeysVector(Jim_Interp interp, Jim_Obj dictPtr,

7464	7892	}
7465	7893	else {
7466	7894	char buf[JIM_INTEGER_SPACE + 1];
7467		if (objPtr->internalRep.intValue >= 0) {
	7895	if (objPtr->internalRep.intValue >= 0 \|\| objPtr->internalRep.intValue == -INT_MAX) {
7468	7896	sprintf(buf, "%d", objPtr->internalRep.intValue);
7469	7897	}
7470	7898	else {

7477	7905
7478	7906	static int SetIndexFromAny(Jim_Interp interp, Jim_Obj objPtr)
7479	7907	{
7480		int idx, end = 0;
	7908	jim_wide idx;
	7909	int end = 0;
7481	7910	const char *str;
7482		char *endptr;
	7911	Jim_Obj *exprObj = objPtr;
	7912
	7913	JimPanic((objPtr->refCount == 0, "SetIndexFromAny() called with zero refcount object"));
7483	7914
7484	7915	/* Get the string representation */
7485	7916	str = Jim_String(objPtr);

7489	7920	end = 1;
7490	7921	str += 3;
7491	7922	idx = 0;
7492		}
7493		else {
7494		idx = jim_strtol(str, &endptr);
7495
7496		if (endptr == str) {
	7923	switch (*str) {
	7924	case '\0':
	7925	exprObj = NULL;
	7926	break;
	7927
	7928	case '-':
	7929	case '+':
	7930	/* Create a temp object here for evaluation, but this only happens
	7931	* once unless the index object shimmers since the result is kept
	7932	*/
	7933	exprObj = Jim_NewStringObj(interp, str, -1);
	7934	break;
	7935
	7936	default:
	7937	goto badindex;
	7938	}
	7939	}
	7940	if (exprObj) {
	7941	int ret;
	7942	Jim_IncrRefCount(exprObj);
	7943	ret = Jim_GetWideExpr(interp, exprObj, &idx);
	7944	Jim_DecrRefCount(interp, exprObj);
	7945	if (ret != JIM_OK) {
7497	7946	goto badindex;
7498	7947	}
7499		str = endptr;
7500		}
7501
7502		/* Now str may include or +<num> or -<num> */
7503		if (str == '+' \|\| str == '-') {
7504		int sign = (*str == '+' ? 1 : -1);
7505
7506		idx += sign * jim_strtol(++str, &endptr);
7507		if (str == endptr \|\| *endptr) {
7508		goto badindex;
7509		}
7510		str = endptr;
7511		}
7512		/* The only thing left should be spaces */
7513		while (isspace(UCHAR(*str))) {
7514		str++;
7515		}
7516		if (*str) {
7517		goto badindex;
7518		}
	7948	}
	7949
7519	7950	if (end) {
7520	7951	if (idx > 0) {
7521	7952	idx = INT_MAX;

7537	7968
7538	7969	badindex:
7539	7970	Jim_SetResultFormatted(interp,
7540		"bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr);
	7971	"bad index \"%#s\": must be intexpr or end?[+-]intexpr?", objPtr);
7541	7972	return JIM_ERR;
7542	7973	}
7543	7974

7671	8102	JIM_EXPROP_STRNE,
7672	8103	JIM_EXPROP_STRIN,
7673	8104	JIM_EXPROP_STRNI,
	8105	JIM_EXPROP_STRLT,
	8106	JIM_EXPROP_STRGT,
	8107	JIM_EXPROP_STRLE,
	8108	JIM_EXPROP_STRGE,
7674	8109
7675	8110	/* Unary operators (numbers) */
7676		JIM_EXPROP_NOT, /* 47 */
	8111	JIM_EXPROP_NOT, /* 51 */
7677	8112	JIM_EXPROP_BITNOT,
7678	8113	JIM_EXPROP_UNARYMINUS,
7679	8114	JIM_EXPROP_UNARYPLUS,
7680	8115
7681	8116	/* Functions */
7682		JIM_EXPROP_FUNC_INT, /* 51 */
	8117	JIM_EXPROP_FUNC_INT, /* 55 */
7683	8118	JIM_EXPROP_FUNC_WIDE,
7684	8119	JIM_EXPROP_FUNC_ABS,
7685	8120	JIM_EXPROP_FUNC_DOUBLE,

7688	8123	JIM_EXPROP_FUNC_SRAND,
7689	8124
7690	8125	/* math functions from libm */
7691		JIM_EXPROP_FUNC_SIN, /* 65 */
	8126	JIM_EXPROP_FUNC_SIN, /* 69 */
7692	8127	JIM_EXPROP_FUNC_COS,
7693	8128	JIM_EXPROP_FUNC_TAN,
7694	8129	JIM_EXPROP_FUNC_ASIN,

7739	8174	static int JimExprOpNumUnary(Jim_Interp interp, struct JimExprNode node)
7740	8175	{
7741	8176	int intresult = 1;
7742		int rc;
	8177	int rc, bA = 0;
7743	8178	double dA, dC = 0;
7744	8179	jim_wide wA, wC = 0;
7745	8180	Jim_Obj *A;

7806	8241	abort();
7807	8242	}
7808	8243	}
	8244	else if ((rc = Jim_GetBoolean(interp, A, &bA)) == JIM_OK) {
	8245	switch (node->type) {
	8246	case JIM_EXPROP_NOT:
	8247	wC = !bA;
	8248	break;
	8249	default:
	8250	abort();
	8251	}
	8252	}
7809	8253
7810	8254	if (rc == JIM_OK) {
7811	8255	if (intresult) {

7826	8270	unsigned long x;
7827	8271	JimRandomBytes(interp, &x, sizeof(x));
7828	8272
7829		return (double)x / (unsigned long)~0;
	8273	return (double)x / (double)~0UL;
7830	8274	}
7831	8275
7832	8276	static int JimExprOpIntUnary(Jim_Interp interp, struct JimExprNode node)

8251	8695	{
8252	8696	Jim_Obj A, B;
8253	8697	jim_wide wC;
8254		int rc;
	8698	int comp, rc;
8255	8699
8256	8700	if ((rc = JimExprGetTerm(interp, node->left, &A)) != JIM_OK) {
8257	8701	return rc;

8267	8711	wC = Jim_StringEqObj(A, B);
8268	8712	if (node->type == JIM_EXPROP_STRNE) {
8269	8713	wC = !wC;
	8714	}
	8715	break;
	8716	case JIM_EXPROP_STRLT:
	8717	case JIM_EXPROP_STRGT:
	8718	case JIM_EXPROP_STRLE:
	8719	case JIM_EXPROP_STRGE:
	8720	comp = Jim_StringCompareObj(interp, A, B, 0);
	8721	if (node->type == JIM_EXPROP_STRLT) {
	8722	wC = comp == -1;
	8723	} else if (node->type == JIM_EXPROP_STRGT) {
	8724	wC = comp == 1;
	8725	} else if (node->type == JIM_EXPROP_STRLE) {
	8726	wC = comp == -1 \|\| comp == 0;
	8727	} else /* JIM_EXPROP_STRGE */ {
	8728	wC = comp == 0 \|\| comp == 1;
8270	8729	}
8271	8730	break;
8272	8731	case JIM_EXPROP_STRIN:

8413	8872
8414	8873	OPRINIT("in", 55, 2, JimExprOpStrBin),
8415	8874	OPRINIT("ni", 55, 2, JimExprOpStrBin),
	8875
	8876	/* Precedence must be higher than ==, !=, eq, ne but lower than
	8877	<, >, <=, >= */
	8878	OPRINIT("lt", 75, 2, JimExprOpStrBin),
	8879	OPRINIT("gt", 75, 2, JimExprOpStrBin),
	8880	OPRINIT("le", 75, 2, JimExprOpStrBin),
	8881	OPRINIT("ge", 75, 2, JimExprOpStrBin),
8416	8882
8417	8883	OPRINIT_ATTR("!", 150, 1, JimExprOpNumUnary, OP_RIGHT_ASSOC),
8418	8884	OPRINIT_ATTR("~", 150, 1, JimExprOpIntUnary, OP_RIGHT_ASSOC),

8459	8925
8460	8926	static int JimParseExpression(struct JimParserCtx *pc)
8461	8927	{
8462		/* Discard spaces and quoted newline */
8463		while (isspace(UCHAR(pc->p)) \|\| ((pc->p) == '\\' && *(pc->p + 1) == '\n')) {
8464		if (*pc->p == '\n') {
8465		pc->linenr++;
8466		}
8467		pc->p++;
8468		pc->len--;
	8928	while (1) {
	8929	/* Discard spaces and quoted newline */
	8930	while (isspace(UCHAR(pc->p)) \|\| ((pc->p) == '\\' && *(pc->p + 1) == '\n')) {
	8931	if (*pc->p == '\n') {
	8932	pc->linenr++;
	8933	}
	8934	pc->p++;
	8935	pc->len--;
	8936	}
	8937	/* Discard comments */
	8938	if (*pc->p == '#') {
	8939	JimParseComment(pc);
	8940	/* Go back to discarding white space */
	8941	continue;
	8942	}
	8943	break;
8469	8944	}
8470	8945
8471	8946	/* Common case */

8592	9067
8593	9068	static int JimParseExprBoolean(struct JimParserCtx *pc)
8594	9069	{
8595		const char *booleans[] = { "false", "no", "off", "true", "yes", "on", NULL };
8596		const int lengths[] = { 5, 2, 3, 4, 3, 2, 0 };
8597	9070	int i;
8598
8599		for (i = 0; booleans[i]; i++) {
8600		const char *boolean = booleans[i];
8601		int length = lengths[i];
8602
8603		if (strncmp(boolean, pc->p, length) == 0) {
8604		pc->p += length;
8605		pc->len -= length;
	9071	for (i = 0; i < sizeof(jim_true_false_strings) / sizeof(*jim_true_false_strings); i++) {
	9072	if (strncmp(pc->p, jim_true_false_strings[i], jim_true_false_lens[i]) == 0) {
	9073	pc->p += jim_true_false_lens[i];
	9074	pc->len -= jim_true_false_lens[i];
8606	9075	pc->tend = pc->p - 1;
8607	9076	pc->tt = JIM_TT_EXPR_BOOLEAN;
8608	9077	return JIM_OK;

8702	9171	FreeExprInternalRep,
8703	9172	DupExprInternalRep,
8704	9173	NULL,
8705		JIM_TYPE_REFERENCES,
	9174	JIM_TYPE_NONE,
8706	9175	};
8707	9176
8708	9177	/* expr tree structure */

8808	9277	*
8809	9278	* 'exp_numterms' indicates how many terms are expected. Normally this is 1, but may be more for EXPR_FUNC_ARGS and EXPR_TERNARY.
8810	9279	*/
8811		static int ExprTreeBuildTree(Jim_Interp interp, struct ExprBuilder builder, int precedence, int flags, int exp_numterms)
8812		{
	9280	static int ExprTreeBuildTree(Jim_Interp interp, struct ExprBuilder builder, int precedence, int flags, int exp_numterms) {
8813	9281	int rc;
8814	9282	struct JimExprNode *node;
8815	9283	/* Calculate the stack length expected after pushing the number of expected terms */

9066	9534	builder.exprObjPtr = exprObjPtr;
9067	9535	builder.fileNameObj = fileNameObj;
9068	9536	/* The bytecode will never produce more nodes than there are tokens - 1 (for EOL)*/
9069		builder.nodes = malloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
	9537	builder.nodes = Jim_Alloc(sizeof(struct JimExprNode) * (tokenlist->count - 1));
9070	9538	memset(builder.nodes, 0, sizeof(struct JimExprNode) * (tokenlist->count - 1));
9071	9539	builder.next = builder.nodes;
9072	9540	Jim_InitStack(&builder.stack);

9261	9729	return JIM_ERR;
9262	9730
9263	9731	case JIM_TT_ESC:
	9732	if (interp->safeexpr) {
	9733	return JIM_ERR;
	9734	}
9264	9735	if (Jim_SubstObj(interp, node->objPtr, &objPtr, JIM_NONE) == JIM_OK) {
9265	9736	Jim_SetResult(interp, objPtr);
9266	9737	return JIM_OK;

9268	9739	return JIM_ERR;
9269	9740
9270	9741	case JIM_TT_CMD:
	9742	if (interp->safeexpr) {
	9743	return JIM_ERR;
	9744	}
9271	9745	return Jim_EvalObj(interp, node->objPtr);
9272	9746
9273	9747	default:

9300	9774	struct ExprTree *expr;
9301	9775	int retcode = JIM_OK;
9302	9776
	9777	Jim_IncrRefCount(exprObjPtr); /* Make sure it's shared. */
9303	9778	expr = JimGetExpression(interp, exprObjPtr);
9304	9779	if (!expr) {
9305		return JIM_ERR; /* error in expression. */
	9780	retcode = JIM_ERR;
	9781	goto done;
9306	9782	}
9307	9783
9308	9784	#ifdef JIM_OPTIMIZATION

9318	9794	* $a != CONST, $a != $b
9319	9795	* $a == CONST, $a == $b
9320	9796	*/
9321		{
	9797	if (!interp->safeexpr) {
9322	9798	Jim_Obj *objPtr;
9323	9799
9324	9800	/* STEP 1 -- Check if there are the conditions to run the specialized

9329	9805	objPtr = JimExprIntValOrVar(interp, expr->expr);
9330	9806	if (objPtr) {
9331	9807	Jim_SetResult(interp, objPtr);
9332		return JIM_OK;
	9808	goto done;
9333	9809	}
9334	9810	break;
9335	9811

9339	9815
9340	9816	if (objPtr && JimIsWide(objPtr)) {
9341	9817	Jim_SetResult(interp, JimWideValue(objPtr) ? interp->falseObj : interp->trueObj);
9342		return JIM_OK;
	9818	goto done;
9343	9819	}
9344	9820	}
9345	9821	break;

9375	9851	goto noopt;
9376	9852	}
9377	9853	Jim_SetResult(interp, cmpRes ? interp->trueObj : interp->falseObj);
9378		return JIM_OK;
	9854	goto done;
9379	9855	}
9380	9856	}
9381	9857	break;

9385	9861	#endif
9386	9862
9387	9863	/* In order to avoid the internal repr being freed due to
9388		* shimmering of the exprObjPtr's object, we make the internal rep
9389		* shared. */
	9864	* shimmering of the exprObjPtr's object, we increment the use count
	9865	* and keep our own pointer outside the object.
	9866	*/
9390	9867	expr->inUse++;
9391	9868
9392	9869	/* Evaluate with the recursive expr engine */
9393	9870	retcode = JimExprEvalTermNode(interp, expr->expr);
9394	9871
9395		expr->inUse--;
	9872	/* Now transfer ownership of expr back into the object in case it shimmered away */
	9873	Jim_FreeIntRep(interp, exprObjPtr);
	9874	exprObjPtr->typePtr = &exprObjType;
	9875	Jim_SetIntRepPtr(exprObjPtr, expr);
	9876
	9877	done:
	9878	Jim_DecrRefCount(interp, exprObjPtr);
9396	9879
9397	9880	return retcode;
9398	9881	}

9716	10199	break; /* EOS via WS if unspecified */
9717	10200
9718	10201	n = utf8_tounicode(str, &c);
9719		if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN))
	10202	if (sdescr && !JimCharsetMatch(sdescr, strlen(sdescr), c, JIM_CHARSET_SCAN))
9720	10203	break;
9721	10204	while (n--)
9722	10205	p++ = str++;

9731	10214	* returned of -1 in case of no conversion tool place and string was
9732	10215	* already scanned thru */
9733	10216
9734		static int ScanOneEntry(Jim_Interp interp, const char str, int pos, int strLen,
	10217	static int ScanOneEntry(Jim_Interp interp, const char str, int pos, int str_bytelen,
9735	10218	ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr)
9736	10219	{
9737	10220	const char *tok;

9746	10229	if (descr->prefix) {
9747	10230	/* There was a prefix given before the conversion, skip it and adjust
9748	10231	* the string-to-be-parsed accordingly */
9749		for (i = 0; pos < strLen && descr->prefix[i]; ++i) {
	10232	for (i = 0; pos < str_bytelen && descr->prefix[i]; ++i) {
9750	10233	/* If prefix require, skip WS */
9751	10234	if (isspace(UCHAR(descr->prefix[i])))
9752		while (pos < strLen && isspace(UCHAR(str[pos])))
	10235	while (pos < str_bytelen && isspace(UCHAR(str[pos])))
9753	10236	++pos;
9754	10237	else if (descr->prefix[i] != str[pos])
9755	10238	break; /* Prefix do not match here, leave the loop */
9756	10239	else
9757	10240	++pos; /* Prefix matched so far, next round */
9758	10241	}
9759		if (pos >= strLen) {
	10242	if (pos >= str_bytelen) {
9760	10243	return -1; /* All of str consumed: EOF condition */
9761	10244	}
9762	10245	else if (descr->prefix[i] != 0)

9766	10249	if (descr->type != 'c' && descr->type != '[' && descr->type != 'n')
9767	10250	while (isspace(UCHAR(str[pos])))
9768	10251	++pos;
	10252
9769	10253	/* Determine how much skipped/scanned so far */
9770	10254	scanned = pos - anchor;
9771	10255

9774	10258	/* Return pseudo conversion means: how much scanned so far? */
9775	10259	*valObjPtr = Jim_NewIntObj(interp, anchor + scanned);
9776	10260	}
9777		else if (pos >= strLen) {
	10261	else if (pos >= str_bytelen) {
9778	10262	/* Cannot scan anything, as str is totally consumed */
9779	10263	return -1;
9780	10264	}
9781	10265	else if (descr->type == 'c') {
9782		int c;
9783		scanned += utf8_tounicode(&str[pos], &c);
9784		*valObjPtr = Jim_NewIntObj(interp, c);
9785		return scanned;
	10266	int c;
	10267	scanned += utf8_tounicode(&str[pos], &c);
	10268	*valObjPtr = Jim_NewIntObj(interp, c);
	10269	return scanned;
9786	10270	}
9787	10271	else {
9788	10272	/* Processing of conversions follows ... */
9789	10273	if (descr->width > 0) {
9790	10274	/* Do not try to scan as fas as possible but only the given width.
9791	10275	* To ensure this, we copy the part that should be scanned. */
9792		size_t sLen = utf8_strlen(&str[pos], strLen - pos);
	10276	size_t sLen = utf8_strlen(&str[pos], str_bytelen - pos);
9793	10277	size_t tLen = descr->width > sLen ? sLen : descr->width;
9794	10278
9795	10279	tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen);

9879	10363	size_t i, pos;
9880	10364	int scanned = 1;
9881	10365	const char *str = Jim_String(strObjPtr);
9882		int strLen = Jim_Utf8Length(interp, strObjPtr);
	10366	int str_bytelen = Jim_Length(strObjPtr);
9883	10367	Jim_Obj *resultList = 0;
9884	10368	Jim_Obj **resultVec = 0;
9885	10369	int resultc;

9916	10400	continue;
9917	10401	/* As long as any conversion could be done, we will proceed */
9918	10402	if (scanned > 0)
9919		scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value);
	10403	scanned = ScanOneEntry(interp, str, pos, str_bytelen, fmtObj, i, &value);
9920	10404	/* In case our first try results in EOF, we will leave */
9921	10405	if (scanned == -1 && i == 0)
9922	10406	goto eof;

10044	10528	return JIM_ERR;
10045	10529	}
10046	10530	if (argc == 3) {
10047		if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK)
	10531	if (Jim_GetWideExpr(interp, argv[2], &increment) != JIM_OK)
10048	10532	return JIM_ERR;
10049	10533	}
10050	10534	intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);

10085	10569	#define JIM_EVAL_SARGV_LEN 8 /* static arguments vector length */
10086	10570	#define JIM_EVAL_SINTV_LEN 8 /* static interpolation vector length */
10087	10571
	10572	static int JimTraceCallback(Jim_Interp interp, const char type, int argc, Jim_Obj const argv)
	10573	{
	10574	JimPanic((interp->traceCmdObj == NULL, "xtrace invoked with no object"));
	10575
	10576	int ret;
	10577	Jim_Obj *nargv[7];
	10578	Jim_Obj *traceCmdObj = interp->traceCmdObj;
	10579	Jim_Obj *resultObj = Jim_GetResult(interp);
	10580	/* Where were we called from? */
	10581	ScriptObj *script = JimGetScript(interp, interp->currentScriptObj);
	10582
	10583	nargv[0] = traceCmdObj;
	10584	nargv[1] = Jim_NewStringObj(interp, type, -1);
	10585	nargv[2] = script->fileNameObj;
	10586	nargv[3] = Jim_NewIntObj(interp, script->linenr);
	10587	nargv[4] = resultObj;
	10588	nargv[5] = argv[0];
	10589	nargv[6] = Jim_NewListObj(interp, argv + 1, argc - 1);
	10590
	10591	/* Remove the trace while executing the trace callback */
	10592	interp->traceCmdObj = NULL;
	10593	/* Invoke the callback */
	10594	Jim_IncrRefCount(resultObj);
	10595	ret = Jim_EvalObjVector(interp, 7, nargv);
	10596	Jim_DecrRefCount(interp, resultObj);
	10597
	10598	if (ret == JIM_OK \|\| ret == JIM_RETURN) {
	10599	/* Reinstall the trace callback */
	10600	interp->traceCmdObj = traceCmdObj;
	10601	Jim_SetEmptyResult(interp);
	10602	ret = JIM_OK;
	10603	}
	10604	else {
	10605	/* No more tracing */
	10606	Jim_DecrRefCount(interp, traceCmdObj);
	10607	}
	10608	return ret;
	10609	}
	10610
10088	10611	/* Handle calls to the [unknown] command */
10089	10612	static int JimUnknown(Jim_Interp interp, int argc, Jim_Obj const *argv)
10090	10613	{

10119	10642	int retcode;
10120	10643	Jim_Cmd *cmdPtr;
10121	10644	void *prevPrivData;
	10645	Jim_Obj *tailcallObj = NULL;
10122	10646
10123	10647	#if 0
10124	10648	printf("invoke");

10129	10653	printf("\n");
10130	10654	#endif
10131	10655
10132		if (interp->framePtr->tailcallCmd) {
10133		/* Special tailcall command was pre-resolved */
10134		cmdPtr = interp->framePtr->tailcallCmd;
10135		interp->framePtr->tailcallCmd = NULL;
10136		}
10137		else {
10138		cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
10139		if (cmdPtr == NULL) {
10140		return JimUnknown(interp, objc, objv);
10141		}
10142		JimIncrCmdRefCount(cmdPtr);
10143		}
	10656	cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG);
	10657	if (cmdPtr == NULL) {
	10658	return JimUnknown(interp, objc, objv);
	10659	}
	10660	JimIncrCmdRefCount(cmdPtr);
10144	10661
10145	10662	if (interp->evalDepth == interp->maxEvalDepth) {
10146	10663	Jim_SetResultString(interp, "Infinite eval recursion", -1);

10150	10667	interp->evalDepth++;
10151	10668	prevPrivData = interp->cmdPrivData;
10152	10669
10153		/* Call it -- Make sure result is an empty object. */
10154		Jim_SetEmptyResult(interp);
10155		if (cmdPtr->isproc) {
10156		retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
10157		}
10158		else {
10159		interp->cmdPrivData = cmdPtr->u.native.privData;
10160		retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
10161		}
	10670	tailcall:
	10671
	10672	if (!interp->traceCmdObj \|\|
	10673	(retcode = JimTraceCallback(interp, "cmd", objc, objv)) == JIM_OK) {
	10674	/* Call it -- Make sure result is an empty object. */
	10675	Jim_SetEmptyResult(interp);
	10676	if (cmdPtr->isproc) {
	10677	retcode = JimCallProcedure(interp, cmdPtr, objc, objv);
	10678	}
	10679	else {
	10680	interp->cmdPrivData = cmdPtr->u.native.privData;
	10681	retcode = cmdPtr->u.native.cmdProc(interp, objc, objv);
	10682	}
	10683	}
	10684
	10685	if (tailcallObj) {
	10686	/* clean up previous tailcall if we were invoking one */
	10687	Jim_DecrRefCount(interp, tailcallObj);
	10688	tailcallObj = NULL;
	10689	}
	10690
	10691	/* If a tailcall is returned for this frame, loop to invoke the new command */
	10692	if (retcode == JIM_EVAL && interp->framePtr->tailcallObj) {
	10693	JimDecrCmdRefCount(interp, cmdPtr);
	10694
	10695	/* Replace the current command with the new tailcall command */
	10696	cmdPtr = interp->framePtr->tailcallCmd;
	10697	interp->framePtr->tailcallCmd = NULL;
	10698	tailcallObj = interp->framePtr->tailcallObj;
	10699	interp->framePtr->tailcallObj = NULL;
	10700	/* We can access the internal rep here because the object can only
	10701	* be constructed by the tailcall command
	10702	*/
	10703	objc = tailcallObj->internalRep.listValue.len;
	10704	objv = tailcallObj->internalRep.listValue.ele;
	10705	goto tailcall;
	10706	}
	10707
10162	10708	interp->cmdPrivData = prevPrivData;
10163	10709	interp->evalDepth--;
10164	10710
10165	10711	out:
10166	10712	JimDecrCmdRefCount(interp, cmdPtr);
	10713
	10714	if (interp->framePtr->tailcallObj) {
	10715	/* We might have skipped invoking a tailcall, perhaps because of an error
	10716	* in defer handling so cleanup now
	10717	*/
	10718	JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
	10719	Jim_DecrRefCount(interp, interp->framePtr->tailcallObj);
	10720	interp->framePtr->tailcallCmd = NULL;
	10721	interp->framePtr->tailcallObj = NULL;
	10722	}
10167	10723
10168	10724	return retcode;
10169	10725	}

10707	11263	}
10708	11264	else {
10709	11265	/* We have plain args */
10710		Jim_AppendString(interp, argmsg, "?arg...?", -1);
	11266	Jim_AppendString(interp, argmsg, "?arg ...?", -1);
10711	11267	}
10712	11268	}
10713	11269	else {

10858	11414	}
10859	11415	}
10860	11416
10861		/* Eval the body */
10862		retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
	11417	if (interp->traceCmdObj == NULL \|\|
	11418	(retcode = JimTraceCallback(interp, "proc", argc, argv)) == JIM_OK) {
	11419	/* Eval the body */
	11420	retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);
	11421	}
10863	11422
10864	11423	badargset:
10865	11424

10867	11426	retcode = JimInvokeDefer(interp, retcode);
10868	11427	interp->framePtr = interp->framePtr->parent;
10869	11428	JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);
10870
10871		/* Now chain any tailcalls in the parent frame */
10872		if (interp->framePtr->tailcallObj) {
10873		do {
10874		Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;
10875
10876		interp->framePtr->tailcallObj = NULL;
10877
10878		if (retcode == JIM_EVAL) {
10879		retcode = Jim_EvalObjList(interp, tailcallObj);
10880		if (retcode == JIM_RETURN) {
10881		/* If the result of the tailcall is 'return', push
10882		* it up to the caller
10883		*/
10884		interp->returnLevel++;
10885		}
10886		}
10887		Jim_DecrRefCount(interp, tailcallObj);
10888		} while (interp->framePtr->tailcallObj);
10889
10890		/* If the tailcall chain finished early, may need to manually discard the command */
10891		if (interp->framePtr->tailcallCmd) {
10892		JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd);
10893		interp->framePtr->tailcallCmd = NULL;
10894		}
10895		}
10896	11429
10897	11430	/* Handle the JIM_RETURN return code */
10898	11431	if (retcode == JIM_RETURN) {

11193	11726	* May add the key and/or value to the list.
11194	11727	*/
11195	11728	typedef void JimHashtableIteratorCallbackType(Jim_Interp interp, Jim_Obj listObjPtr,
11196		Jim_HashEntry *he, int type);
	11729	Jim_Obj keyObjPtr, void value, Jim_Obj *patternObjPtr, int type);
11197	11730
11198	11731	#define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL)
11199	11732
11200	11733	/**
11201		* For each key of the hash table 'ht' (with string keys) which matches the glob pattern (all if NULL),
11202		* invoke the callback to add entries to a list.
	11734	* For each key of the hash table 'ht' with object keys that
	11735	* matches the glob pattern (all if NULL), invoke the callback to add entries to a list.
11203	11736	* Returns the list.
11204	11737	*/
11205	11738	static Jim_Obj JimHashtablePatternMatch(Jim_Interp interp, Jim_HashTable ht, Jim_Obj patternObjPtr,

11210	11743
11211	11744	/* Check for the non-pattern case. We can do this much more efficiently. */
11212	11745	if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) {
11213		he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr));
	11746	he = Jim_FindHashEntry(ht, patternObjPtr);
11214	11747	if (he) {
11215		callback(interp, listObjPtr, he, type);
	11748	callback(interp, listObjPtr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he),
	11749	patternObjPtr, type);
11216	11750	}
11217	11751	}
11218	11752	else {
11219	11753	Jim_HashTableIterator htiter;
11220	11754	JimInitHashTableIterator(ht, &htiter);
11221	11755	while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
11222		if (patternObjPtr == NULL \|\| JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) {
11223		callback(interp, listObjPtr, he, type);
11224		}
	11756	callback(interp, listObjPtr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he),
	11757	patternObjPtr, type);
11225	11758	}
11226	11759	}
11227	11760	return listObjPtr;

11236	11769	* Adds matching command names (procs, channels) to the list.
11237	11770	*/
11238	11771	static void JimCommandMatch(Jim_Interp interp, Jim_Obj listObjPtr,
11239		Jim_HashEntry *he, int type)
11240		{
11241		Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he);
11242		Jim_Obj *objPtr;
	11772	Jim_Obj keyObj, void value, Jim_Obj *patternObj, int type)
	11773	{
	11774	Jim_Cmd cmdPtr = (Jim_Cmd )value;
11243	11775
11244	11776	if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) {
11245	11777	/* not a proc */
11246	11778	return;
11247	11779	}
11248	11780
11249		objPtr = Jim_NewStringObj(interp, he->key, -1);
11250		Jim_IncrRefCount(objPtr);
11251
11252		if (type != JIM_CMDLIST_CHANNELS \|\| Jim_AioFilehandle(interp, objPtr)) {
11253		Jim_ListAppendElement(interp, listObjPtr, objPtr);
11254		}
11255		Jim_DecrRefCount(interp, objPtr);
11256		}
11257
11258		/* type is JIM_CMDLIST_xxx */
	11781	Jim_IncrRefCount(keyObj);
	11782
	11783	if (type != JIM_CMDLIST_CHANNELS \|\| Jim_AioFilehandle(interp, keyObj)) {
	11784	int match = 1;
	11785	if (patternObj) {
	11786	int plen, slen;
	11787	const char *pattern = Jim_GetStringNoQualifier(patternObj, &plen);
	11788	const char *str = Jim_GetStringNoQualifier(keyObj, &slen);
	11789	match = JimGlobMatch(pattern, plen, str, slen, 0);
	11790	}
	11791	if (match) {
	11792	Jim_ListAppendElement(interp, listObjPtr, keyObj);
	11793	}
	11794	}
	11795	Jim_DecrRefCount(interp, keyObj);
	11796	}
	11797
11259	11798	static Jim_Obj JimCommandsList(Jim_Interp interp, Jim_Obj *patternObjPtr, int type)
11260	11799	{
11261	11800	return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type);

11265	11804	#define JIM_VARLIST_GLOBALS 0
11266	11805	#define JIM_VARLIST_LOCALS 1
11267	11806	#define JIM_VARLIST_VARS 2
	11807	#define JIM_VARLIST_MASK 0x000f
11268	11808
11269	11809	#define JIM_VARLIST_VALUES 0x1000
11270	11810

11272	11812	* Adds matching variable names to the list.
11273	11813	*/
11274	11814	static void JimVariablesMatch(Jim_Interp interp, Jim_Obj listObjPtr,
11275		Jim_HashEntry *he, int type)
11276		{
11277		Jim_Var *varPtr = Jim_GetHashEntryVal(he);
11278
11279		if (type != JIM_VARLIST_LOCALS \|\| varPtr->linkFramePtr == NULL) {
11280		Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
11281		if (type & JIM_VARLIST_VALUES) {
11282		Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
	11815	Jim_Obj keyObj, void value, Jim_Obj *patternObj, int type)
	11816	{
	11817	Jim_Var varPtr = (Jim_Var )value;
	11818
	11819	if ((type & JIM_VARLIST_MASK) != JIM_VARLIST_LOCALS \|\| varPtr->linkFramePtr == NULL) {
	11820	if (patternObj == NULL \|\| Jim_StringMatchObj(interp, patternObj, keyObj, 0)) {
	11821	Jim_ListAppendElement(interp, listObjPtr, keyObj);
	11822	if (type & JIM_VARLIST_VALUES) {
	11823	Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr);
	11824	}
11283	11825	}
11284	11826	}
11285	11827	}

11288	11830	static Jim_Obj JimVariablesList(Jim_Interp interp, Jim_Obj *patternObjPtr, int mode)
11289	11831	{
11290	11832	if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) {
11291		/* For [info locals], if we are at top level an emtpy list
	11833	/* For [info locals], if we are at top level an empty list
11292	11834	* is returned. I don't agree, but we aim at compatibility (SS) */
11293	11835	return interp->emptyObj;
11294	11836	}
11295	11837	else {
11296	11838	Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr;
11297		return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode);
	11839	return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch,
	11840	mode);
11298	11841	}
11299	11842	}
11300	11843

11664	12207
11665	12208	/* Get the stop condition (must be a variable or integer) */
11666	12209	if (expr->expr->right->type == JIM_TT_EXPR_INT) {
11667		if (Jim_GetWide(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
	12210	if (Jim_GetWideExpr(interp, expr->expr->right->objPtr, &stop) == JIM_ERR) {
11668	12211	goto evalstart;
11669	12212	}
11670	12213	}

11771	12314	jim_wide incr = 1;
11772	12315	Jim_Obj *bodyObjPtr;
11773	12316
11774		if (argc != 5 && argc != 6) {
11775		Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body");
	12317	if (argc < 4 \|\| argc > 6) {
	12318	Jim_WrongNumArgs(interp, 1, argv, "var ?first? limit ?incr? body");
11776	12319	return JIM_ERR;
11777	12320	}
11778	12321
11779		if (Jim_GetWide(interp, argv[2], &i) != JIM_OK \|\|
11780		Jim_GetWide(interp, argv[3], &limit) != JIM_OK \|\|
11781		(argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) {
11782		return JIM_ERR;
11783		}
11784		bodyObjPtr = (argc == 5) ? argv[4] : argv[5];
11785
11786		retval = Jim_SetVariable(interp, argv[1], argv[2]);
	12322	retval = Jim_GetWideExpr(interp, argv[2], &i);
	12323	if (argc > 4 && retval == JIM_OK) {
	12324	retval = Jim_GetWideExpr(interp, argv[3], &limit);
	12325	}
	12326	if (argc > 5 && retval == JIM_OK) {
	12327	Jim_GetWideExpr(interp, argv[4], &incr);
	12328	}
	12329	if (retval != JIM_OK) {
	12330	return retval;
	12331	}
	12332	if (argc == 4) {
	12333	limit = i;
	12334	i = 0;
	12335	}
	12336	bodyObjPtr = argv[argc - 1];
	12337
	12338	retval = Jim_SetVariable(interp, argv[1], Jim_NewIntObj(interp, i));
11787	12339
11788	12340	while (((i < limit && incr > 0) \|\| (i > limit && incr < 0)) && retval == JIM_OK) {
11789	12341	retval = Jim_EvalObj(interp, bodyObjPtr);

12064	12616	}
12065	12617
12066	12618
12067		/* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)*/
	12619	/* Returns 1 if match, 0 if no match or -<error> on error (e.g. -JIM_ERR, -JIM_BREAK)
	12620	* flags may contain JIM_NOCASE and/or JIM_OPT_END
	12621	*/
12068	12622	int Jim_CommandMatchObj(Jim_Interp interp, Jim_Obj commandObj, Jim_Obj *patternObj,
12069		Jim_Obj *stringObj, int nocase)
12070		{
12071		Jim_Obj *parms[4];
	12623	Jim_Obj *stringObj, int flags)
	12624	{
	12625	Jim_Obj *parms[5];
12072	12626	int argc = 0;
12073	12627	long eq;
12074	12628	int rc;
12075	12629
12076	12630	parms[argc++] = commandObj;
12077		if (nocase) {
	12631	if (flags & JIM_NOCASE) {
12078	12632	parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1);
	12633	}
	12634	if (flags & JIM_OPT_END) {
	12635	parms[argc++] = Jim_NewStringObj(interp, "--", -1);
12079	12636	}
12080	12637	parms[argc++] = patternObj;
12081	12638	parms[argc++] = stringObj;

12094	12651	{
12095	12652	enum { SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD };
12096	12653	int matchOpt = SWITCH_EXACT, opt = 1, patCount, i;
	12654	int match_flags = 0;
12097	12655	Jim_Obj command = NULL, scriptObj = NULL, *strObj;
12098	12656	Jim_Obj **caseList;
12099	12657

12116	12674	matchOpt = SWITCH_EXACT;
12117	12675	else if (strncmp(option, "-glob", 2) == 0)
12118	12676	matchOpt = SWITCH_GLOB;
12119		else if (strncmp(option, "-regexp", 2) == 0)
	12677	else if (strncmp(option, "-regexp", 2) == 0) {
12120	12678	matchOpt = SWITCH_RE;
	12679	match_flags \|= JIM_OPT_END;
	12680	}
12121	12681	else if (strncmp(option, "-command", 2) == 0) {
12122	12682	matchOpt = SWITCH_CMD;
12123	12683	if ((argc - opt) < 2)

12160	12720	command = Jim_NewStringObj(interp, "regexp", -1);
12161	12721	/* Fall thru intentionally */
12162	12722	case SWITCH_CMD:{
12163		int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0);
	12723	int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, match_flags);
12164	12724
12165	12725	/* After the execution of a command we need to
12166	12726	* make sure to reconvert the object into a list

12208	12768	/* [lindex] */
12209	12769	static int Jim_LindexCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
12210	12770	{
12211		Jim_Obj objPtr, listObjPtr;
12212		int i;
12213		int idx;
	12771	Jim_Obj *objPtr;
	12772	int ret;
12214	12773
12215	12774	if (argc < 2) {
12216	12775	Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?");
12217	12776	return JIM_ERR;
12218	12777	}
12219		objPtr = argv[1];
12220		Jim_IncrRefCount(objPtr);
12221		for (i = 2; i < argc; i++) {
12222		listObjPtr = objPtr;
12223		if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) {
12224		Jim_DecrRefCount(interp, listObjPtr);
12225		return JIM_ERR;
12226		}
12227		if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) {
12228		/* Returns an empty object if the index
12229		* is out of range. */
12230		Jim_DecrRefCount(interp, listObjPtr);
12231		Jim_SetEmptyResult(interp);
12232		return JIM_OK;
12233		}
12234		Jim_IncrRefCount(objPtr);
12235		Jim_DecrRefCount(interp, listObjPtr);
12236		}
12237		Jim_SetResult(interp, objPtr);
12238		Jim_DecrRefCount(interp, objPtr);
12239		return JIM_OK;
	12778	ret = Jim_ListIndices(interp, argv[1], argv + 2, argc - 2, &objPtr, JIM_NONE);
	12779	if (ret < 0) {
	12780	/* Returns an empty object if the index
	12781	* is out of range. */
	12782	ret = JIM_OK;
	12783	Jim_SetEmptyResult(interp);
	12784	}
	12785	else if (ret == JIM_OK) {
	12786	Jim_SetResult(interp, objPtr);
	12787	}
	12788	return ret;
12240	12789	}
12241	12790
12242	12791	/* [llength] */

12255	12804	{
12256	12805	static const char * const options[] = {
12257	12806	"-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command",
12258		NULL
	12807	"-stride", "-index", NULL
12259	12808	};
12260	12809	enum
12261	12810	{ OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE,
12262		OPT_COMMAND };
	12811	OPT_COMMAND, OPT_STRIDE, OPT_INDEX };
12263	12812	int i;
12264	12813	int opt_bool = 0;
12265	12814	int opt_not = 0;
12266		int opt_nocase = 0;
12267	12815	int opt_all = 0;
12268	12816	int opt_inline = 0;
12269	12817	int opt_match = OPT_EXACT;

12271	12819	int rc = JIM_OK;
12272	12820	Jim_Obj *listObjPtr = NULL;
12273	12821	Jim_Obj *commandObj = NULL;
	12822	Jim_Obj *indexObj = NULL;
	12823	int match_flags = 0;
	12824	long stride = 1;
12274	12825
12275	12826	if (argc < 3) {
12276	12827	wrongargs:
12277	12828	Jim_WrongNumArgs(interp, 1, argv,
12278		"?-exact\|-glob\|-regexp\|-command 'command'? ?-bool\|-inline? ?-not? ?-nocase? ?-all? list value");
	12829	"?-exact\|-glob\|-regexp\|-command 'command'? ?-bool\|-inline? ?-not? ?-nocase? ?-all? ?-stride len? ?-index val? list value");
12279	12830	return JIM_ERR;
12280	12831	}
12281	12832

12294	12845	opt_not = 1;
12295	12846	break;
12296	12847	case OPT_NOCASE:
12297		opt_nocase = 1;
	12848	match_flags \|= JIM_NOCASE;
12298	12849	break;
12299	12850	case OPT_INLINE:
12300	12851	opt_inline = 1;

12303	12854	case OPT_ALL:
12304	12855	opt_all = 1;
12305	12856	break;
	12857	case OPT_REGEXP:
	12858	opt_match = option;
	12859	match_flags \|= JIM_OPT_END;
	12860	break;
12306	12861	case OPT_COMMAND:
12307	12862	if (i >= argc - 2) {
12308	12863	goto wrongargs;

12311	12866	/* fallthru */
12312	12867	case OPT_EXACT:
12313	12868	case OPT_GLOB:
12314		case OPT_REGEXP:
12315	12869	opt_match = option;
12316	12870	break;
12317		}
12318		}
12319
	12871	case OPT_INDEX:
	12872	if (i >= argc - 2) {
	12873	goto wrongargs;
	12874	}
	12875	indexObj = argv[++i];
	12876	break;
	12877	case OPT_STRIDE:
	12878	if (i >= argc - 2) {
	12879	goto wrongargs;
	12880	}
	12881	if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) {
	12882	return JIM_ERR;
	12883	}
	12884	if (stride < 1) {
	12885	Jim_SetResultString(interp, "stride length must be at least 1", -1);
	12886	return JIM_ERR;
	12887	}
	12888	break;
	12889	}
	12890	}
	12891
	12892	argc -= i;
	12893	if (argc < 2) {
	12894	goto wrongargs;
	12895	}
12320	12896	argv += i;
	12897
	12898	listlen = Jim_ListLength(interp, argv[0]);
	12899	if (listlen % stride) {
	12900	Jim_SetResultString(interp, "list size must be a multiple of the stride length", -1);
	12901	return JIM_ERR;
	12902	}
12321	12903
12322	12904	if (opt_all) {
12323	12905	listObjPtr = Jim_NewListObj(interp, NULL, 0);

12329	12911	Jim_IncrRefCount(commandObj);
12330	12912	}
12331	12913
12332		listlen = Jim_ListLength(interp, argv[0]);
12333		for (i = 0; i < listlen; i++) {
	12914	for (i = 0; i < listlen; i += stride) {
12334	12915	int eq = 0;
12335		Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i);
	12916	Jim_Obj *searchListObj;
	12917	Jim_Obj *objPtr;
	12918	int offset;
	12919
	12920	if (indexObj) {
	12921	int indexlen = Jim_ListLength(interp, indexObj);
	12922	if (stride == 1) {
	12923	searchListObj = Jim_ListGetIndex(interp, argv[0], i);
	12924	}
	12925	else {
	12926	searchListObj = Jim_NewListObj(interp, argv[0]->internalRep.listValue.ele + i, stride);
	12927	}
	12928	Jim_IncrRefCount(searchListObj);
	12929	rc = Jim_ListIndices(interp, searchListObj, indexObj->internalRep.listValue.ele, indexlen, &objPtr, JIM_ERRMSG);
	12930	if (rc != JIM_OK) {
	12931	Jim_DecrRefCount(interp, searchListObj);
	12932	rc = JIM_ERR;
	12933	goto done;
	12934	}
	12935	/* now indexObj is the object to compare */
	12936	offset = 0;
	12937	}
	12938	else {
	12939	/* No -index, so we have an implicit {0} as indexObj */
	12940	searchListObj = argv[0];
	12941	offset = i;
	12942	objPtr = Jim_ListGetIndex(interp, searchListObj, i);
	12943	Jim_IncrRefCount(searchListObj);
	12944	}
	12945	/* At this point objPtr represents the object to search against and
	12946	* searchListObj represents the list we search in (offset .. offset + stride - 1)
	12947	* both need to have reference counts decremented when done
	12948	*/
12336	12949
12337	12950	switch (opt_match) {
12338	12951	case OPT_EXACT:
12339		eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0;
	12952	eq = Jim_StringCompareObj(interp, argv[1], objPtr, match_flags) == 0;
12340	12953	break;
12341	12954
12342	12955	case OPT_GLOB:
12343		eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase);
	12956	eq = Jim_StringMatchObj(interp, argv[1], objPtr, match_flags);
12344	12957	break;
12345	12958
12346	12959	case OPT_REGEXP:
12347	12960	case OPT_COMMAND:
12348		eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase);
	12961	eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, match_flags);
12349	12962	if (eq < 0) {
12350		if (listObjPtr) {
12351		Jim_FreeNewObj(interp, listObjPtr);
12352		}
	12963	Jim_DecrRefCount(interp, searchListObj);
12353	12964	rc = JIM_ERR;
12354	12965	goto done;
12355	12966	}
12356	12967	break;
12357	12968	}
12358	12969
12359		/* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */
12360		if (!eq && opt_bool && opt_not && !opt_all) {
12361		continue;
12362		}
12363
	12970	/* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12364	12971	if ((!opt_bool && eq == !opt_not) \|\| (opt_bool && (eq \|\| opt_all))) {
12365		/* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */
12366	12972	Jim_Obj *resultObj;
12367	12973
12368	12974	if (opt_bool) {

12371	12977	else if (!opt_inline) {
12372	12978	resultObj = Jim_NewIntObj(interp, i);
12373	12979	}
	12980	else if (stride == 1) {
	12981	resultObj = objPtr;
	12982	}
	12983	else if (opt_all) {
	12984	/* Add the entire sublist directly for -all -stride > 1 */
	12985	ListInsertElements(listObjPtr, -1, stride,
	12986	searchListObj->internalRep.listValue.ele + offset);
	12987	/* Not necessary, but some compilers can't figure that out */
	12988	resultObj = NULL;
	12989	}
12374	12990	else {
12375		resultObj = objPtr;
	12991	resultObj = Jim_NewListObj(interp, searchListObj->internalRep.listValue.ele + offset, stride);
12376	12992	}
12377	12993
12378	12994	if (opt_all) {
12379		Jim_ListAppendElement(interp, listObjPtr, resultObj);
	12995	/* The stride > 1 case has already been handled above */
	12996	if (stride == 1) {
	12997	Jim_ListAppendElement(interp, listObjPtr, resultObj);
	12998	}
12380	12999	}
12381	13000	else {
12382	13001	Jim_SetResult(interp, resultObj);
	13002	Jim_DecrRefCount(interp, searchListObj);
12383	13003	goto done;
12384	13004	}
12385	13005	}
	13006	Jim_DecrRefCount(interp, searchListObj);
12386	13007	}
12387	13008
12388	13009	if (opt_all) {
12389	13010	Jim_SetResult(interp, listObjPtr);
	13011	listObjPtr = NULL;
12390	13012	}
12391	13013	else {
12392	13014	/* No match */

12399	13021	}
12400	13022
12401	13023	done:
	13024	if (listObjPtr) {
	13025	Jim_FreeNewObj(interp, listObjPtr);
	13026	}
12402	13027	if (commandObj) {
12403	13028	Jim_DecrRefCount(interp, commandObj);
12404	13029	}

12518	13143	static int Jim_LsetCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
12519	13144	{
12520	13145	if (argc < 3) {
12521		Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal");
	13146	Jim_WrongNumArgs(interp, 1, argv, "listVar ?index ...? value");
12522	13147	return JIM_ERR;
12523	13148	}
12524	13149	else if (argc == 3) {

12535	13160	static int Jim_LsortCoreCommand(Jim_Interp interp, int argc, Jim_Obj const argv[])
12536	13161	{
12537	13162	static const char * const options[] = {
12538		"-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL
	13163	"-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique",
	13164	"-stride", NULL
12539	13165	};
12540		enum
12541		{ OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE };
	13166	enum {
	13167	OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE,
	13168	OPT_STRIDE
	13169	};
12542	13170	Jim_Obj *resObj;
12543	13171	int i;
12544	13172	int retCode;
12545	13173	int shared;
	13174	long stride = 1;
12546	13175
12547	13176	struct lsort_info info;
12548	13177
12549	13178	if (argc < 2) {
	13179	wrongargs:
12550	13180	Jim_WrongNumArgs(interp, 1, argv, "?options? list");
12551	13181	return JIM_ERR;
12552	13182	}
12553	13183
12554	13184	info.type = JIM_LSORT_ASCII;
12555	13185	info.order = 1;
12556		info.indexed = 0;
	13186	info.indexc = 0;
12557	13187	info.unique = 0;
12558	13188	info.command = NULL;
12559	13189	info.interp = interp;

12595	13225	info.command = argv[i + 1];
12596	13226	i++;
12597	13227	break;
	13228	case OPT_STRIDE:
	13229	if (i >= argc - 2) {
	13230	goto wrongargs;
	13231	}
	13232	if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) {
	13233	return JIM_ERR;
	13234	}
	13235	if (stride < 2) {
	13236	Jim_SetResultString(interp, "stride length must be at least 2", -1);
	13237	return JIM_ERR;
	13238	}
	13239	break;
12598	13240	case OPT_INDEX:
12599	13241	if (i >= (argc - 2)) {
	13242	badindex:
12600	13243	Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1);
12601	13244	return JIM_ERR;
12602	13245	}
12603		if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) {
12604		return JIM_ERR;
12605		}
12606		info.indexed = 1;
	13246	JimListGetElements(interp, argv[i + 1], &info.indexc, &info.indexv);
	13247	if (info.indexc == 0) {
	13248	goto badindex;
	13249	}
12607	13250	i++;
12608	13251	break;
12609	13252	}
12610	13253	}
12611	13254	resObj = argv[argc - 1];
12612		if ((shared = Jim_IsShared(resObj)))
12613		resObj = Jim_DuplicateObj(interp, resObj);
12614		retCode = ListSortElements(interp, resObj, &info);
12615		if (retCode == JIM_OK) {
12616		Jim_SetResult(interp, resObj);
12617		}
12618		else if (shared) {
12619		Jim_FreeNewObj(interp, resObj);
	13255	if (stride > 1) {
	13256	Jim_Obj *tmpListObj;
	13257	Jim_Obj **elements;
	13258	int listlen;
	13259	int i;
	13260
	13261	JimListGetElements(interp, resObj, &listlen, &elements);
	13262	if (listlen % stride) {
	13263	Jim_SetResultString(interp, "list size must be a multiple of the stride length", -1);
	13264	return JIM_ERR;
	13265	}
	13266	/* Need to create a new list of lists for sorting */
	13267	tmpListObj = Jim_NewListObj(interp, NULL, 0);
	13268	Jim_IncrRefCount(tmpListObj);
	13269	for (i = 0; i < listlen; i += stride) {
	13270	Jim_ListAppendElement(interp, tmpListObj, Jim_NewListObj(interp, elements + i, stride));
	13271	}
	13272	retCode = ListSortElements(interp, tmpListObj, &info);
	13273	if (retCode == JIM_OK) {
	13274	resObj = Jim_NewListObj(interp, NULL, 0);
	13275	/* Now we need to unpack the result back into a flat list */
	13276	for (i = 0; i < listlen; i += stride) {
	13277	Jim_ListAppendList(interp, resObj, Jim_ListGetIndex(interp, tmpListObj, i / stride));
	13278	}
	13279	Jim_SetResult(interp, resObj);
	13280	}
	13281	Jim_DecrRefCount(interp, tmpListObj);
	13282	}
	13283	else {
	13284	if ((shared = Jim_IsShared(resObj))) {
	13285	resObj = Jim_DuplicateObj(interp, resObj);
	13286	}
	13287	retCode = ListSortElements(interp, resObj, &info);
	13288	if (retCode == JIM_OK) {
	13289	Jim_SetResult(interp, resObj);
	13290	}
	13291	else if (shared) {
	13292	Jim_FreeNewObj(interp, resObj);
	13293	}
12620	13294	}
12621	13295	return retCode;
12622	13296	}

12690	13364	#endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12691	13365
12692	13366	/* [debug] */
	13367	#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12693	13368	static int Jim_DebugCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
12694	13369	{
12695		#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
12696	13370	static const char * const options[] = {
12697	13371	"refcount", "objcount", "objects", "invstr", "scriptlen", "exprlen",
12698	13372	"exprbc", "show",

12748	13422	else if (option == OPT_OBJECTS) {
12749	13423	Jim_Obj objPtr, listObjPtr, *subListObjPtr;
12750	13424
	13425	if (argc != 2) {
	13426	Jim_WrongNumArgs(interp, 2, argv, "");
	13427	return JIM_ERR;
	13428	}
	13429
12751	13430	/* Count the number of live objects. */
12752	13431	objPtr = interp->liveList;
12753	13432	listObjPtr = Jim_NewListObj(interp, NULL, 0);

12794	13473	#else
12795	13474	charlen = len;
12796	13475	#endif
12797		printf("refcount: %d, type: %s\n", argv[2]->refCount, JimObjTypeName(argv[2]));
12798		printf("chars (%d): <<%s>>\n", charlen, s);
12799		printf("bytes (%d):", len);
	13476	char buf[256];
	13477	snprintf(buf, sizeof(buf), "refcount: %d, type: %s\n"
	13478	"chars (%d):",
	13479	argv[2]->refCount, JimObjTypeName(argv[2]), charlen);
	13480	Jim_SetResultFormatted(interp, "%s <<%s>>\n", buf, s);
	13481	snprintf(buf, sizeof(buf), "bytes (%d):", len);
	13482	Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
12800	13483	while (len--) {
12801		printf(" %02x", (unsigned char)*s++);
12802		}
12803		printf("\n");
	13484	snprintf(buf, sizeof(buf), " %02x", (unsigned char)*s++);
	13485	Jim_AppendString(interp, Jim_GetResult(interp), buf, -1);
	13486	}
12804	13487	return JIM_OK;
12805	13488	}
12806	13489	else if (option == OPT_SCRIPTLEN) {

12848	13531	return JIM_ERR;
12849	13532	}
12850	13533	/* unreached */
	13534	}
12851	13535	#endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
12852		#if !defined(JIM_DEBUG_COMMAND)
12853		Jim_SetResultString(interp, "unsupported", -1);
12854		return JIM_ERR;
12855		#endif
12856		}
12857	13536
12858	13537	/* [eval] */
12859	13538	static int Jim_EvalCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)

12932	13611	if (argc == 2) {
12933	13612	retcode = Jim_EvalExpression(interp, argv[1]);
12934	13613	}
	13614	#ifndef JIM_COMPAT
	13615	else {
	13616	Jim_WrongNumArgs(interp, 1, argv, "expression");
	13617	retcode = JIM_ERR;
	13618	}
	13619	#else
12935	13620	else if (argc > 2) {
12936	13621	Jim_Obj *objPtr;
12937	13622

12944	13629	Jim_WrongNumArgs(interp, 1, argv, "expression ?...?");
12945	13630	return JIM_ERR;
12946	13631	}
12947		if (retcode != JIM_OK)
12948		return retcode;
12949		return JIM_OK;
	13632	#endif
	13633	return retcode;
12950	13634	}
12951	13635
12952	13636	/* [break] */

13020	13704	if (i == argc - 1) {
13021	13705	Jim_SetResult(interp, argv[i]);
13022	13706	}
13023		return JIM_RETURN;
	13707	return level == 0 ? returnCode : JIM_RETURN;
13024	13708	}
13025	13709
13026	13710	/* [tailcall] */

13078	13762	static int Jim_AliasCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
13079	13763	{
13080	13764	Jim_Obj *prefixListObj;
13081		const char *newname;
13082	13765
13083	13766	if (argc < 3) {
13084	13767	Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?");

13087	13770
13088	13771	prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2);
13089	13772	Jim_IncrRefCount(prefixListObj);
13090		newname = Jim_String(argv[1]);
13091		if (newname[0] == ':' && newname[1] == ':') {
13092		while (*++newname == ':') {
13093		}
13094		}
13095
13096	13773	Jim_SetResult(interp, argv[1]);
13097	13774
13098		return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete);
	13775	return Jim_CreateCommandObj(interp, argv[1], JimAliasCmd, prefixListObj, JimAliasCmdDelete);
13099	13776	}
13100	13777
13101	13778	/* [proc] */

13108	13785	return JIM_ERR;
13109	13786	}
13110	13787
13111		if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
13112		return JIM_ERR;
13113		}
13114
13115	13788	if (argc == 4) {
13116	13789	cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL);
13117	13790	}

13121	13794
13122	13795	if (cmd) {
13123	13796	/* Add the new command */
13124		Jim_Obj *qualifiedCmdNameObj;
13125		const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj);
13126
13127		JimCreateCommand(interp, cmdname, cmd);
	13797	Jim_Obj *nameObjPtr = JimQualifyName(interp, argv[1]);
	13798	JimCreateCommand(interp, nameObjPtr, cmd);
13128	13799
13129	13800	/* Calculate and set the namespace for this proc */
13130		JimUpdateProcNamespace(interp, cmd, cmdname);
13131
13132		JimFreeQualifiedName(interp, qualifiedCmdNameObj);
	13801	JimUpdateProcNamespace(interp, cmd, nameObjPtr);
	13802	Jim_DecrRefCount(interp, nameObjPtr);
13133	13803
13134	13804	/* Unlike Tcl, set the name of the proc as the result */
13135	13805	Jim_SetResult(interp, argv[1]);
13136	13806	return JIM_OK;
13137	13807	}
13138	13808	return JIM_ERR;
	13809	}
	13810
	13811	/* [xtrace] */
	13812	static int Jim_XtraceCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
	13813	{
	13814	if (argc != 2) {
	13815	Jim_WrongNumArgs(interp, 1, argv, "callback");
	13816	return JIM_ERR;
	13817	}
	13818
	13819	if (interp->traceCmdObj) {
	13820	Jim_DecrRefCount(interp, interp->traceCmdObj);
	13821	interp->traceCmdObj = NULL;
	13822	}
	13823
	13824	if (Jim_Length(argv[1])) {
	13825	/* Install the new execution trace callback */
	13826	interp->traceCmdObj = argv[1];
	13827	Jim_IncrRefCount(interp->traceCmdObj);
	13828	}
	13829	return JIM_OK;
13139	13830	}
13140	13831
13141	13832	/* [local] */

13225	13916
13226	13917	if (len == 3) {
13227	13918	#ifdef jim_ext_namespace
13228		/* Need to canonicalise the given namespace. */
13229		nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2));
	13919	/* Note that the namespace is always treated as global */
	13920	nsObj = Jim_ListGetIndex(interp, argv[1], 2);
13230	13921	#else
13231	13922	Jim_SetResultString(interp, "namespaces not enabled", -1);
13232	13923	return JIM_ERR;

13352	14043
13353	14044	if (strLen >= kl && kl) {
13354	14045	int rc;
13355		rc = JimStringCompareLen(str, k, kl, nocase);
	14046	rc = JimStringCompareUtf8(str, kl, k, kl, nocase);
13356	14047	if (rc == 0) {
13357	14048	if (noMatchStart) {
13358	14049	Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart);

13486	14177	Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1]));
13487	14178	}
13488	14179	else {
	14180	const char *s1 = Jim_String(argv[0]);
	14181	int l1 = Jim_Utf8Length(interp, argv[0]);
	14182	const char *s2 = Jim_String(argv[1]);
	14183	int l2 = Jim_Utf8Length(interp, argv[1]);
13489	14184	if (opt_length >= 0) {
13490		n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case);
	14185	if (l1 > opt_length) {
	14186	l1 = opt_length;
	14187	}
	14188	if (l2 > opt_length) {
	14189	l2 = opt_length;
	14190	}
13491	14191	}
13492		else {
13493		n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case);
13494		}
	14192	n = JimStringCompareUtf8(s1, l1, s2, l2, !opt_case);
13495	14193	Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0);
13496	14194	}
13497	14195	return JIM_OK;

13580	14278	Jim_WrongNumArgs(interp, 2, argv, "string count");
13581	14279	return JIM_ERR;
13582	14280	}
13583		if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) {
	14281	if (Jim_GetWideExpr(interp, argv[3], &count) != JIM_OK) {
13584	14282	return JIM_ERR;
13585	14283	}
13586	14284	objPtr = Jim_NewStringObj(interp, "", 0);

13605	14303
13606	14304	str = Jim_GetString(argv[2], &len);
13607	14305	buf = Jim_Alloc(len + 1);
	14306	assert(buf);
13608	14307	p = buf + len;
13609	14308	*p = 0;
13610	14309	for (i = 0; i < len; ) {

13632	14331	}
13633	14332	str = Jim_String(argv[2]);
13634	14333	len = Jim_Utf8Length(interp, argv[2]);
13635		if (idx != INT_MIN && idx != INT_MAX) {
13636		idx = JimRelToAbsIndex(len, idx);
13637		}
	14334	idx = JimRelToAbsIndex(len, idx);
13638	14335	if (idx < 0 \|\| idx >= len \|\| str == NULL) {
13639	14336	Jim_SetResultString(interp, "", 0);
13640	14337	}

13668	14365	return JIM_ERR;
13669	14366	}
13670	14367	idx = JimRelToAbsIndex(l2, idx);
	14368	if (idx < 0) {
	14369	idx = 0;
	14370	}
13671	14371	}
13672	14372	else if (option == OPT_LAST) {
13673	14373	idx = l2;

13740	14440	{
13741	14441	long i, count = 1;
13742	14442	jim_wide start, elapsed;
13743		char buf[60];
13744		const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration";
13745	14443
13746	14444	if (argc < 2) {
13747	14445	Jim_WrongNumArgs(interp, 1, argv, "script ?count?");

13764	14462	}
13765	14463	}
13766	14464	elapsed = JimClock() - start;
13767		sprintf(buf, fmt, count == 0 ? 0 : elapsed / count);
13768		Jim_SetResultString(interp, buf, -1);
	14465	if (elapsed < count * 10) {
	14466	Jim_SetResult(interp, Jim_NewDoubleObj(interp, elapsed * 1.0 / count));
	14467	}
	14468	else {
	14469	Jim_SetResultInt(interp, count == 0 ? 0 : elapsed / count);
	14470	}
	14471	Jim_AppendString(interp, Jim_GetResult(interp)," microseconds per iteration", -1);
13769	14472	return JIM_OK;
13770	14473	}
13771	14474

13781	14484	if (argc == 2) {
13782	14485	if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK)
13783	14486	return JIM_ERR;
	14487	Jim_SetResult(interp, argv[1]);
13784	14488	}
13785	14489	interp->exitCode = exitCode;
13786	14490	return JIM_EXIT;
13787	14491	}
13788	14492
13789		/* [catch] */
13790		static int Jim_CatchCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
13791		{
	14493	static int JimMatchReturnCodes(Jim_Interp interp, Jim_Obj retcodeListObj, int rc)
	14494	{
	14495	int len = Jim_ListLength(interp, retcodeListObj);
	14496	int i;
	14497	for (i = 0; i < len; i++) {
	14498	int returncode;
	14499	if (Jim_GetReturnCode(interp, Jim_ListGetIndex(interp, retcodeListObj, i), &returncode) != JIM_OK) {
	14500	return JIM_ERR;
	14501	}
	14502	if (rc == returncode) {
	14503	return JIM_OK;
	14504	}
	14505	}
	14506	return -1;
	14507	}
	14508
	14509	/* Implements both [try] and [catch] */
	14510	static int JimCatchTryHelper(Jim_Interp interp, int istry, int argc, Jim_Obj const *argv)
	14511	{
	14512	static const char * const wrongargs_catchtry[2] = {
	14513	"?-?no?code ... --? script ?resultVarName? ?optionVarName?",
	14514	"?-?no?code ... --? script ?on codes vars script? ... ?finally script?"
	14515	};
13792	14516	int exitCode = 0;
13793	14517	int i;
13794	14518	int sig = 0;
	14519	int ok;
	14520	Jim_Obj *finallyScriptObj = NULL;
	14521	Jim_Obj *msgVarObj = NULL;
	14522	Jim_Obj *optsVarObj = NULL;
	14523	Jim_Obj *onScriptObj = NULL;
	14524	int idx;
13795	14525
13796	14526	/* Which return codes are ignored (passed through)? By default, only exit, eval and signal */
13797	14527	jim_wide ignore_mask = (1 << JIM_EXIT) \| (1 << JIM_EVAL) \| (1 << JIM_SIGNAL);
13798	14528	static const int max_ignore_code = sizeof(ignore_mask) * 8;
13799	14529
13800		/* Reset the error code before catch.
	14530	JimPanic((istry != 0 && istry != 1, "wrong args to JimCatchTryHelper"));
	14531
	14532	/* Reset the error code before catch/try.
13801	14533	* Note that this is not strictly correct.
13802	14534	*/
13803	14535	Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1));

13843	14575	}
13844	14576	}
13845	14577
13846		argc -= i;
13847		if (argc < 1 \|\| argc > 3) {
13848		wrongargs:
13849		Jim_WrongNumArgs(interp, 1, argv,
13850		"?-?no?code ... --? script ?resultVarName? ?optionVarName?");
	14578	idx = i;
	14579
	14580	if (argc - idx < 1) {
	14581	wrongargs:
	14582	Jim_WrongNumArgs(interp, 1, argv, wrongargs_catchtry[istry]);
13851	14583	return JIM_ERR;
13852	14584	}
13853		argv += i;
13854	14585
13855	14586	if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) {
13856	14587	sig++;

13862	14593	exitCode = JIM_SIGNAL;
13863	14594	}
13864	14595	else {
13865		exitCode = Jim_EvalObj(interp, argv[0]);
	14596	exitCode = Jim_EvalObj(interp, argv[idx]);
13866	14597	/* Don't want any caught error included in a later stack trace */
13867	14598	interp->errorFlag = 0;
13868	14599	}
13869	14600	interp->signal_level -= sig;
	14601
	14602	/* For try, we need to find both a matching return code and finally (if they exist)
	14603	* Set: finallyScriptObj
	14604	* onScriptObj
	14605	* msgVarObj
	14606	* optsVarObj
	14607	* Any of these can be NULL;
	14608	*/
	14609	idx++;
	14610	if (istry) {
	14611	while (idx < argc) {
	14612	if (Jim_CompareStringImmediate(interp, argv[idx], "on")) {
	14613	int ret;
	14614	if (idx + 4 > argc) {
	14615	goto wrongargs;
	14616	}
	14617	ret = JimMatchReturnCodes(interp, argv[idx + 1], exitCode);
	14618	if (ret > JIM_OK) {
	14619	goto wrongargs;
	14620	}
	14621	if (ret == JIM_OK) {
	14622	msgVarObj = Jim_ListGetIndex(interp, argv[idx + 2], 0);
	14623	optsVarObj = Jim_ListGetIndex(interp, argv[idx + 2], 1);
	14624	onScriptObj = argv[idx + 3];
	14625	}
	14626	idx += 4;
	14627	}
	14628	else if (Jim_CompareStringImmediate(interp, argv[idx], "finally")) {
	14629	if (idx + 2 != argc) {
	14630	goto wrongargs;
	14631	}
	14632	finallyScriptObj = argv[idx + 1];
	14633	idx += 2;
	14634	}
	14635	else {
	14636	goto wrongargs;
	14637	}
	14638	}
	14639	}
	14640	else {
	14641	if (argc - idx >= 1) {
	14642	msgVarObj = argv[idx];
	14643	idx++;
	14644	if (argc - idx >= 1) {
	14645	optsVarObj = argv[idx];
	14646	idx++;
	14647	}
	14648	}
	14649	}
13870	14650
13871	14651	/* Catch or pass through? Only the first 32/64 codes can be passed through */
13872	14652	if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) {
13873	14653	/* Not caught, pass it up */
	14654	if (finallyScriptObj) {
	14655	Jim_EvalObj(interp, finallyScriptObj);
	14656	}
13874	14657	return exitCode;
13875	14658	}
13876	14659

13879	14662	if (interp->signal_set_result) {
13880	14663	interp->signal_set_result(interp, interp->sigmask);
13881	14664	}
	14665	else if (!istry) {
	14666	Jim_SetResultInt(interp, interp->sigmask);
	14667	}
	14668	interp->sigmask = 0;
	14669	}
	14670
	14671	ok = 1;
	14672	if (msgVarObj && Jim_Length(msgVarObj)) {
	14673	if (Jim_SetVariable(interp, msgVarObj, Jim_GetResult(interp)) != JIM_OK) {
	14674	ok = 0;
	14675	}
	14676	}
	14677	if (ok && optsVarObj && Jim_Length(optsVarObj)) {
	14678	Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
	14679
	14680	Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
	14681	Jim_ListAppendElement(interp, optListObj,
	14682	Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
	14683	Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
	14684	Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
	14685	if (exitCode == JIM_ERR) {
	14686	Jim_Obj *errorCode;
	14687	Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
	14688	-1));
	14689	Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
	14690
	14691	errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
	14692	if (errorCode) {
	14693	Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
	14694	Jim_ListAppendElement(interp, optListObj, errorCode);
	14695	}
	14696	}
	14697	if (Jim_SetVariable(interp, optsVarObj, optListObj) != JIM_OK) {
	14698	ok = 0;
	14699	}
	14700	}
	14701	if (ok && onScriptObj) {
	14702	/* Execute the on script. Any return code replaces the original. */
	14703	exitCode = Jim_EvalObj(interp, onScriptObj);
	14704	}
	14705
	14706	if (finallyScriptObj) {
	14707	/* Execute the on script. If OK, restore previous resul/exitcode */
	14708	Jim_Obj *prevResultObj = Jim_GetResult(interp);
	14709	Jim_IncrRefCount(prevResultObj);
	14710	int ret = Jim_EvalObj(interp, finallyScriptObj);
	14711	if (ret == JIM_OK) {
	14712	Jim_SetResult(interp, prevResultObj);
	14713	}
13882	14714	else {
13883		Jim_SetResultInt(interp, interp->sigmask);
13884		}
13885		interp->sigmask = 0;
13886		}
13887
13888		if (argc >= 2) {
13889		if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) {
13890		return JIM_ERR;
13891		}
13892		if (argc == 3) {
13893		Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0);
13894
13895		Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1));
13896		Jim_ListAppendElement(interp, optListObj,
13897		Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode));
13898		Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1));
13899		Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel));
13900		if (exitCode == JIM_ERR) {
13901		Jim_Obj *errorCode;
13902		Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo",
13903		-1));
13904		Jim_ListAppendElement(interp, optListObj, interp->stackTrace);
13905
13906		errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE);
13907		if (errorCode) {
13908		Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1));
13909		Jim_ListAppendElement(interp, optListObj, errorCode);
13910		}
13911		}
13912		if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) {
13913		return JIM_ERR;
13914		}
13915		}
13916		}
13917		Jim_SetResultInt(interp, exitCode);
13918		return JIM_OK;
	14715	exitCode = ret;
	14716	}
	14717	Jim_DecrRefCount(interp, prevResultObj);
	14718	}
	14719	if (!istry) {
	14720	Jim_SetResultInt(interp, exitCode);
	14721	exitCode = JIM_OK;
	14722	}
	14723	return exitCode;
	14724	}
	14725
	14726	/* [catch] */
	14727	static int Jim_CatchCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
	14728	{
	14729	return JimCatchTryHelper(interp, 0, argc, argv);
	14730	}
	14731
	14732	/* [try] */
	14733	static int Jim_TryCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
	14734	{
	14735	return JimCatchTryHelper(interp, 1, argc, argv);
13919	14736	}
13920	14737
13921	14738	#if defined(JIM_REFERENCES) && !defined(JIM_BOOTSTRAP)

14042	14859	return JIM_ERR;
14043	14860	}
14044	14861
14045		if (JimValidName(interp, "new procedure", argv[2])) {
14046		return JIM_ERR;
14047		}
14048
14049		return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2]));
	14862	return Jim_RenameCommand(interp, argv[1], argv[2]);
14050	14863	}
14051	14864
14052	14865	#define JIM_DICTMATCH_KEYS 0x0001

14058	14871	*/
14059	14872	int Jim_DictMatchTypes(Jim_Interp interp, Jim_Obj objPtr, Jim_Obj *patternObj, int match_type, int return_types)
14060	14873	{
14061		Jim_HashEntry *he;
14062	14874	Jim_Obj *listObjPtr;
14063		Jim_HashTableIterator htiter;
	14875	Jim_Dict *dict;
	14876	int i;
14064	14877
14065	14878	if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14066	14879	return JIM_ERR;
14067	14880	}
	14881	dict = objPtr->internalRep.dictValue;
14068	14882
14069	14883	listObjPtr = Jim_NewListObj(interp, NULL, 0);
14070	14884
14071		JimInitHashTableIterator(objPtr->internalRep.ptr, &htiter);
14072		while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
	14885	for (i = 0; i < dict->len; i += 2 ) {
	14886	Jim_Obj *keyObj = dict->table[i];
	14887	Jim_Obj *valObj = dict->table[i + 1];
14073	14888	if (patternObj) {
14074		Jim_Obj matchObj = (match_type == JIM_DICTMATCH_KEYS) ? (Jim_Obj )he->key : Jim_GetHashEntryVal(he);
14075		if (!JimGlobMatch(Jim_String(patternObj), Jim_String(matchObj), 0)) {
	14889	Jim_Obj *matchObj = (match_type == JIM_DICTMATCH_KEYS) ? keyObj : valObj;
	14890	if (!Jim_StringMatchObj(interp, patternObj, matchObj, 0)) {
14076	14891	/* no match */
14077	14892	continue;
14078	14893	}
14079	14894	}
14080	14895	if (return_types & JIM_DICTMATCH_KEYS) {
14081		Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key);
	14896	Jim_ListAppendElement(interp, listObjPtr, keyObj);
14082	14897	}
14083	14898	if (return_types & JIM_DICTMATCH_VALUES) {
14084		Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he));
	14899	Jim_ListAppendElement(interp, listObjPtr, valObj);
14085	14900	}
14086	14901	}
14087	14902

14094	14909	if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14095	14910	return -1;
14096	14911	}
14097		return ((Jim_HashTable *)objPtr->internalRep.ptr)->used;
	14912	return objPtr->internalRep.dictValue->len / 2;
14098	14913	}
14099	14914
14100	14915	/**

14111	14926	/* Note that we don't optimise the trivial case of a single argument */
14112	14927
14113	14928	for (i = 0; i < objc; i++) {
14114		Jim_HashTable *ht;
14115		Jim_HashTableIterator htiter;
14116		Jim_HashEntry *he;
14117
14118		if (SetDictFromAny(interp, objv[i]) != JIM_OK) {
	14929	Jim_Obj **table;
	14930	int tablelen;
	14931	int j;
	14932
	14933	/* If the object is a list, avoid converting to a dictionary as
	14934	* we may mishandle duplicate keys
	14935	*/
	14936	table = Jim_DictPairs(interp, objv[i], &tablelen);
	14937	if (tablelen && !table) {
14119	14938	Jim_FreeNewObj(interp, objPtr);
14120	14939	return NULL;
14121	14940	}
14122		ht = objv[i]->internalRep.ptr;
14123		JimInitHashTableIterator(ht, &htiter);
14124		while ((he = Jim_NextHashEntry(&htiter)) != NULL) {
14125		Jim_ReplaceHashEntry(objPtr->internalRep.ptr, Jim_GetHashEntryKey(he), Jim_GetHashEntryVal(he));
	14941	for (j = 0; j < tablelen; j += 2) {
	14942	DictAddElement(interp, objPtr, table[j], table[j + 1]);
14126	14943	}
14127	14944	}
14128	14945	return objPtr;

14130	14947
14131	14948	int Jim_DictInfo(Jim_Interp interp, Jim_Obj objPtr)
14132	14949	{
14133		Jim_HashTable *ht;
14134		unsigned int i;
14135	14950	char buffer[100];
14136		int sum = 0;
14137		int nonzero_count = 0;
14138	14951	Jim_Obj *output;
14139		int bucket_counts[11] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
	14952	Jim_Dict *dict;
14140	14953
14141	14954	if (SetDictFromAny(interp, objPtr) != JIM_OK) {
14142	14955	return JIM_ERR;
14143	14956	}
14144	14957
14145		ht = (Jim_HashTable *)objPtr->internalRep.ptr;
	14958	dict = objPtr->internalRep.dictValue;
14146	14959
14147	14960	/* Note that this uses internal knowledge of the hash table */
14148		snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets\n", ht->used, ht->size);
	14961	snprintf(buffer, sizeof(buffer), "%d entries in table, %d buckets", dict->len, dict->size);
14149	14962	output = Jim_NewStringObj(interp, buffer, -1);
14150
14151		for (i = 0; i < ht->size; i++) {
14152		Jim_HashEntry *he = ht->table[i];
14153		int entries = 0;
14154		while (he) {
14155		entries++;
14156		he = he->next;
14157		}
14158		if (entries > 9) {
14159		bucket_counts[10]++;
14160		}
14161		else {
14162		bucket_counts[entries]++;
14163		}
14164		if (entries) {
14165		sum += entries;
14166		nonzero_count++;
14167		}
14168		}
14169		for (i = 0; i < 10; i++) {
14170		snprintf(buffer, sizeof(buffer), "number of buckets with %d entries: %d\n", i, bucket_counts[i]);
14171		Jim_AppendString(interp, output, buffer, -1);
14172		}
14173		snprintf(buffer, sizeof(buffer), "number of buckets with 10 or more entries: %d\n", bucket_counts[10]);
14174		Jim_AppendString(interp, output, buffer, -1);
14175		snprintf(buffer, sizeof(buffer), "average search distance for entry: %.1f", nonzero_count ? (double)sum / nonzero_count : 0.0);
14176		Jim_AppendString(interp, output, buffer, -1);
14177	14963	Jim_SetResult(interp, output);
14178	14964	return JIM_OK;
14179	14965	}

14206	14992	return JIM_ERR;
14207	14993	}
14208	14994	/* Set the local variables */
14209		if (Jim_DictPairs(interp, objPtr, &dictValues, &len) == JIM_ERR) {
	14995	dictValues = Jim_DictPairs(interp, objPtr, &len);
	14996	if (len && dictValues == NULL) {
14210	14997	return JIM_ERR;
14211	14998	}
14212	14999	for (i = 0; i < len; i += 2) {
14213	15000	if (Jim_SetVariable(interp, dictValues[i], dictValues[i + 1]) == JIM_ERR) {
14214		Jim_Free(dictValues);
14215	15001	return JIM_ERR;
14216	15002	}
14217	15003	}

14238	15024	}
14239	15025	}
14240	15026
14241		Jim_Free(dictValues);
14242
14243	15027	return ret;
14244	15028	}
14245	15029

14247	15031	static int Jim_DictCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
14248	15032	{
14249	15033	Jim_Obj *objPtr;
	15034	int rc;
14250	15035	int types = JIM_DICTMATCH_KEYS;
14251	15036	int option;
14252	15037	static const char * const options[] = {
14253	15038	"create", "get", "set", "unset", "exists", "keys", "size", "info",
14254	15039	"merge", "with", "append", "lappend", "incr", "remove", "values", "for",
14255		"replace", "update", NULL
	15040	"replace", "update", "getwithdefault", NULL
14256	15041	};
14257	15042	enum
14258	15043	{
14259	15044	OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO,
14260	15045	OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR,
14261		OPT_REPLACE, OPT_UPDATE,
	15046	OPT_REPLACE, OPT_UPDATE, OPT_GETDEF,
14262	15047	};
14263	15048
14264	15049	if (argc < 2) {

14267	15052	}
14268	15053
14269	15054	if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) {
14270		return Jim_CheckShowCommands(interp, argv[1], options);
	15055	/* Handle getdef as an alias for getwithdefault */
	15056	if (Jim_CompareStringImmediate(interp, argv[1], "getdef") == 0) {
	15057	return Jim_CheckShowCommands(interp, argv[1], options);
	15058	}
	15059	option = OPT_GETDEF;
14271	15060	}
14272	15061
14273	15062	switch (option) {

14283	15072	Jim_SetResult(interp, objPtr);
14284	15073	return JIM_OK;
14285	15074
	15075	case OPT_GETDEF:
	15076	if (argc < 5) {
	15077	Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...? key default");
	15078	return JIM_ERR;
	15079	}
	15080	rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 4, &objPtr, JIM_ERRMSG);
	15081	if (rc == -1) {
	15082	/* Not a valid dictionary */
	15083	return JIM_ERR;
	15084	}
	15085	if (rc == JIM_ERR) {
	15086	Jim_SetResult(interp, argv[argc - 1]);
	15087	}
	15088	else {
	15089	Jim_SetResult(interp, objPtr);
	15090	}
	15091	return JIM_OK;
	15092
14286	15093	case OPT_SET:
14287	15094	if (argc < 5) {
14288	15095	Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value");

14296	15103	return JIM_ERR;
14297	15104	}
14298	15105	else {
14299		int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG);
	15106	int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_NONE);
14300	15107	if (rc < 0) {
14301	15108	return JIM_ERR;
14302	15109	}

14309	15116	Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?");
14310	15117	return JIM_ERR;
14311	15118	}
14312		if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) {
	15119	if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, JIM_NONE) != JIM_OK) {
14313	15120	return JIM_ERR;
14314	15121	}
14315	15122	return JIM_OK;

14421	15228	Jim_SetResult(interp, objPtr);
14422	15229	return JIM_OK;
14423	15230	}
	15231
	15232	#ifdef jim_ext_namespace
	15233	static int JimIsGlobalNamespace(Jim_Obj *objPtr)
	15234	{
	15235	int len;
	15236	const char *str = Jim_GetString(objPtr, &len);
	15237	return len >= 2 && str[0] == ':' && str[1] == ':';
	15238	}
	15239	#endif
14424	15240
14425	15241	/* [info] */
14426	15242	static int Jim_InfoCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)

14507	15323	}
14508	15324	#ifdef jim_ext_namespace
14509	15325	if (!nons) {
14510		if (Jim_Length(interp->framePtr->nsObj) \|\| (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
	15326	if (Jim_Length(interp->framePtr->nsObj) \|\| (argc == 3 && JimIsGlobalNamespace(argv[2]))) {
14511	15327	return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14512	15328	}
14513	15329	}

14529	15345	}
14530	15346	#ifdef jim_ext_namespace
14531	15347	if (!nons) {
14532		if (Jim_Length(interp->framePtr->nsObj) \|\| (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) {
	15348	if (Jim_Length(interp->framePtr->nsObj) \|\| (argc == 3 && JimIsGlobalNamespace(argv[2]))) {
14533	15349	return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1);
14534	15350	}
14535	15351	}

15011	15827	static int Jim_LrepeatCoreCommand(Jim_Interp interp, int argc, Jim_Obj const *argv)
15012	15828	{
15013	15829	Jim_Obj *objPtr;
15014		long count;
15015
15016		if (argc < 2 \|\| Jim_GetLong(interp, argv[1], &count) != JIM_OK \|\| count < 0) {
	15830	jim_wide count;
	15831
	15832	if (argc < 2 \|\| Jim_GetWideExpr(interp, argv[1], &count) != JIM_OK \|\| count < 0) {
15017	15833	Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?");
15018	15834	return JIM_ERR;
15019	15835	}
15020
15021	15836	if (count == 0 \|\| argc == 2) {
	15837	Jim_SetEmptyResult(interp);
15022	15838	return JIM_OK;
15023	15839	}
15024	15840
15025	15841	argc -= 2;
15026	15842	argv += 2;
15027	15843
15028		objPtr = Jim_NewListObj(interp, argv, argc);
15029		while (--count) {
	15844	objPtr = Jim_NewListObj(interp, NULL, 0);
	15845	ListEnsureLength(objPtr, argc * count);
	15846	while (count--) {
15030	15847	ListInsertElements(objPtr, -1, argc, argv);
15031	15848	}
15032	15849

15086	15903	return JIM_OK;
15087	15904	}
15088	15905
15089		if (argc < 2) {
	15906	if (argc > 3) {
15090	15907	Jim_WrongNumArgs(interp, 1, argv, "varName ?default?");
15091	15908	return JIM_ERR;
15092	15909	}

15129	15946	return JIM_ERR;
15130	15947	}
15131	15948	JimListGetElements(interp, argv[1], &len, &ele);
	15949	revObjPtr = Jim_NewListObj(interp, NULL, 0);
	15950	ListEnsureLength(revObjPtr, len);
15132	15951	len--;
15133		revObjPtr = Jim_NewListObj(interp, NULL, 0);
15134	15952	while (len >= 0)
15135	15953	ListAppendElement(revObjPtr, ele[len--]);
15136	15954	Jim_SetResult(interp, revObjPtr);

15175	15993	return JIM_ERR;
15176	15994	}
15177	15995	if (argc == 2) {
15178		if (Jim_GetWide(interp, argv[1], &end) != JIM_OK)
	15996	if (Jim_GetWideExpr(interp, argv[1], &end) != JIM_OK)
15179	15997	return JIM_ERR;
15180	15998	}
15181	15999	else {
15182		if (Jim_GetWide(interp, argv[1], &start) != JIM_OK \|\|
15183		Jim_GetWide(interp, argv[2], &end) != JIM_OK)
	16000	if (Jim_GetWideExpr(interp, argv[1], &start) != JIM_OK \|\|
	16001	Jim_GetWideExpr(interp, argv[2], &end) != JIM_OK)
15184	16002	return JIM_ERR;
15185		if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK)
	16003	if (argc == 4 && Jim_GetWideExpr(interp, argv[3], &step) != JIM_OK)
15186	16004	return JIM_ERR;
15187	16005	}
15188	16006	if ((len = JimRangeLen(start, end, step)) == -1) {

15190	16008	return JIM_ERR;
15191	16009	}
15192	16010	objPtr = Jim_NewListObj(interp, NULL, 0);
	16011	ListEnsureLength(objPtr, len);
15193	16012	for (i = 0; i < len; i++)
15194	16013	ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step));
15195	16014	Jim_SetResult(interp, objPtr);

15208	16027	if (argc == 1) {
15209	16028	max = JIM_WIDE_MAX;
15210	16029	} else if (argc == 2) {
15211		if (Jim_GetWide(interp, argv[1], &max) != JIM_OK)
	16030	if (Jim_GetWideExpr(interp, argv[1], &max) != JIM_OK)
15212	16031	return JIM_ERR;
15213	16032	} else if (argc == 3) {
15214		if (Jim_GetWide(interp, argv[1], &min) != JIM_OK \|\|
15215		Jim_GetWide(interp, argv[2], &max) != JIM_OK)
	16033	if (Jim_GetWideExpr(interp, argv[1], &min) != JIM_OK \|\|
	16034	Jim_GetWideExpr(interp, argv[2], &max) != JIM_OK)
15216	16035	return JIM_ERR;
15217	16036	}
15218	16037	len = max-min;

15263	16082	{"lreplace", Jim_LreplaceCoreCommand},
15264	16083	{"lsort", Jim_LsortCoreCommand},
15265	16084	{"append", Jim_AppendCoreCommand},
	16085	#if defined(JIM_DEBUG_COMMAND) && !defined(JIM_BOOTSTRAP)
15266	16086	{"debug", Jim_DebugCoreCommand},
	16087	#endif /* JIM_DEBUG_COMMAND && !JIM_BOOTSTRAP */
15267	16088	{"eval", Jim_EvalCoreCommand},
15268	16089	{"uplevel", Jim_UplevelCoreCommand},
15269	16090	{"expr", Jim_ExprCoreCommand},
15270	16091	{"break", Jim_BreakCoreCommand},
15271	16092	{"continue", Jim_ContinueCoreCommand},
15272	16093	{"proc", Jim_ProcCoreCommand},
	16094	{"xtrace", Jim_XtraceCoreCommand},
15273	16095	{"concat", Jim_ConcatCoreCommand},
15274	16096	{"return", Jim_ReturnCoreCommand},
15275	16097	{"upvar", Jim_UpvarCoreCommand},

15278	16100	{"time", Jim_TimeCoreCommand},
15279	16101	{"exit", Jim_ExitCoreCommand},
15280	16102	{"catch", Jim_CatchCoreCommand},
	16103	{"try", Jim_TryCoreCommand},
15281	16104	#ifdef JIM_REFERENCES
15282	16105	{"ref", Jim_RefCoreCommand},
15283	16106	{"getref", Jim_GetrefCoreCommand},

15570	16393	}
15571	16394	}
15572	16395
	16396	/* Should be called as the first thing in a loadable module to verify
	16397	* that the interpeter ABI is compatible with the ABI that the module was compiled against.
	16398	* Returns JIM_ERR and sets an error if mismatch.
	16399	*/
	16400	int Jim_CheckAbiVersion(Jim_Interp *interp, int abi_version)
	16401	{
	16402	if (abi_version != JIM_ABI_VERSION) {
	16403	Jim_SetResultString(interp, "ABI version mismatch", -1);
	16404	return JIM_ERR;
	16405	}
	16406	return JIM_OK;
	16407	}
	16408
15573	16409	/* stubs */
15574	16410	#ifndef jim_ext_package
15575	16411	int Jim_PackageProvide(Jim_Interp interp, const char name, const char *ver, int flags)

+46

-10

jim.h less more

124	124	* Exported defines
125	125	* ---------------------------------------------------------------------------*/
126	126
	127	/* Increment this every time the public ABI changes */
	128	#define JIM_ABI_VERSION 100
	129
127	130	#define JIM_OK 0
128	131	#define JIM_ERR 1
129	132	#define JIM_RETURN 2

132	135	#define JIM_SIGNAL 5
133	136	#define JIM_EXIT 6
134	137	/* The following are internal codes and should never been seen/used */
135		#define JIM_EVAL 7
	138	#define JIM_EVAL 7 /* tailcall */
136	139
137	140	#define JIM_MAX_CALLFRAME_DEPTH 1000 /* default max nesting depth for procs */
138	141	#define JIM_MAX_EVAL_DEPTH 2000 /* default max nesting depth for eval */

160	163	/* Flags used by API calls getting a 'nocase' argument. */
161	164	#define JIM_CASESENS 0 /* case sensitive */
162	165	#define JIM_NOCASE 1 /* no case */
	166	#define JIM_OPT_END 2 /* if implemented by a command (e.g. regexp), add -- to the argument list */
163	167
164	168	/* Filesystem related */
165	169	#define JIM_PATH_LEN 1024

234	238	(entry)->u.val = (_val_); \
235	239	} while(0)
236	240
	241	#define Jim_SetHashIntVal(ht, entry, _val_) (entry)->u.intval = (_val_)
	242
237	243	#define Jim_FreeEntryKey(ht, entry) \
238	244	if ((ht)->type->keyDestructor) \
239	245	(ht)->type->keyDestructor((ht)->privdata, (entry)->key)

254	260
255	261	#define Jim_GetHashEntryKey(he) ((he)->key)
256	262	#define Jim_GetHashEntryVal(he) ((he)->u.val)
	263	#define Jim_GetHashEntryIntVal(he) ((he)->u.intval)
257	264	#define Jim_GetHashTableCollisions(ht) ((ht)->collisions)
258	265	#define Jim_GetHashTableSize(ht) ((ht)->size)
259	266	#define Jim_GetHashTableUsed(ht) ((ht)->used)

316	323	int len; /* Length */
317	324	int maxLen; /* Allocated 'ele' length */
318	325	} listValue;
	326	/* dict object */
	327	struct Jim_Dict *dictValue;
319	328	/* String type */
320	329	struct {
321	330	int maxLength;

453	462	Jim_Obj const argv);
454	463	typedef void Jim_DelCmdProc(struct Jim_Interp interp, void privData);
455	464
456
	465	/* The dict structure. It uses the same approach as Python OrderedDict
	466	* of storing a hash table of table offsets into a table containing keys and objects.
	467	* This preserves order when adding and replacing elements.
	468	*/
	469	typedef struct Jim_Dict {
	470	struct JimDictHashEntry {
	471	int offset;
	472	unsigned hash;
	473	} ht; / Allocated hash table of size 'size' */
	474	unsigned int size; /* Size of the hash table (0 or power of two) */
	475	unsigned int sizemask; /* mask to apply to hash to index into offsets table */
	476	unsigned int uniq; /* unique value to add to hash generator */
	477	Jim_Obj *table; / Table of alternating key, value elements */
	478	int len; /* Number of used elements in table */
	479	int maxLen; /* Allocated length of table */
	480	} Jim_Dict;
457	481
458	482	/* A command is implemented in C if isproc is 0, otherwise
459	483	* it is a Tcl procedure with the arglist and body represented by the

524	548	'ID' field contained in the Jim_CallFrame
525	549	structure. */
526	550	int local; /* If 'local' is in effect, newly defined procs keep a reference to the old defn */
	551	int quitting; /* Set to 1 during Jim_FreeInterp() */
	552	int safeexpr; /* Set when evaluating a "safe" expression, no var subst or command eval */
527	553	Jim_Obj liveList; / Linked list of all the live objects. */
528	554	Jim_Obj freeList; / Linked list of all the unused objects. */
529	555	Jim_Obj currentScriptObj; / Script currently in execution. */

538	564	is running as sentinel to avoid to recursive
539	565	calls via the [collect] command inside
540	566	finalizers. */
541		time_t lastCollectTime; /* unix time of the last GC execution */
	567	jim_wide lastCollectTime; /* unix time of the last GC execution */
542	568	Jim_Obj stackTrace; / Stack trace object. */
543	569	Jim_Obj errorProc; / Name of last procedure which returned an error */
544	570	Jim_Obj unknown; / Unknown command cache */
	571	Jim_Obj defer; / "jim::defer" */
	572	Jim_Obj traceCmdObj; / If non-null, execution trace command to invoke */
545	573	int unknown_called; /* The unknown command has been invoked */
546	574	int errorFlag; /* Set if an error occurred during execution. */
547	575	void cmdPrivData; / Used to pass the private data pointer to
548	576	a command. It is set to what the user specified
549	577	via Jim_CreateCommand(). */
550	578
	579	Jim_Cmd oldCmdCache; / commands that have been deleted, but may still be cached */
	580	int oldCmdCacheSize; /* Number of delete commands */
551	581	struct Jim_CallFrame freeFramesList; / list of CallFrame structures. */
552	582	struct Jim_HashTable assocData; /* per-interp storage for use by packages */
553	583	Jim_PrngState prngState; / per interpreter Random Number Gen. state. */

559	589	* At some point may be a real function doing more work.
560	590	* The proc epoch is used in order to know when a command lookup
561	591	* cached can no longer considered valid. */
562		#define Jim_InterpIncrProcEpoch(i) (i)->procEpoch++
563	592	#define Jim_SetResultString(i,s,l) Jim_SetResult(i, Jim_NewStringObj(i,s,l))
564	593	#define Jim_SetResultInt(i,intval) Jim_SetResult(i, Jim_NewIntObj(i,intval))
565	594	/* Note: Using trueObj and falseObj here makes some things slower...*/

698	727	Jim_Obj objPtr, const char str);
699	728	JIM_EXPORT int Jim_StringCompareObj(Jim_Interp interp, Jim_Obj firstObjPtr,
700	729	Jim_Obj *secondObjPtr, int nocase);
701		JIM_EXPORT int Jim_StringCompareLenObj(Jim_Interp interp, Jim_Obj firstObjPtr,
702		Jim_Obj *secondObjPtr, int nocase);
703	730	JIM_EXPORT int Jim_Utf8Length(Jim_Interp interp, Jim_Obj objPtr);
704	731
705	732	/* reference object */

723	750	const char cmdName, Jim_CmdProc cmdProc, void *privData,
724	751	Jim_DelCmdProc *delProc);
725	752	JIM_EXPORT int Jim_DeleteCommand (Jim_Interp *interp,
726		const char *cmdName);
	753	Jim_Obj *cmdNameObj);
727	754	JIM_EXPORT int Jim_RenameCommand (Jim_Interp *interp,
728		const char oldName, const char newName);
	755	Jim_Obj oldNameObj, Jim_Obj newNameObj);
729	756	JIM_EXPORT Jim_Cmd * Jim_GetCommand (Jim_Interp *interp,
730	757	Jim_Obj *objPtr, int flags);
731	758	JIM_EXPORT int Jim_SetVariable (Jim_Interp *interp,

796	823	JIM_EXPORT int Jim_SetDictKeysVector (Jim_Interp *interp,
797	824	Jim_Obj varNamePtr, Jim_Obj const *keyv, int keyc,
798	825	Jim_Obj *newObjPtr, int flags);
799		JIM_EXPORT int Jim_DictPairs(Jim_Interp *interp,
800		Jim_Obj dictPtr, Jim_Obj *objPtrPtr, int len);
	826	JIM_EXPORT Jim_Obj *Jim_DictPairs(Jim_Interp interp,
	827	Jim_Obj dictPtr, int len);
801	828	JIM_EXPORT int Jim_DictAddElement(Jim_Interp interp, Jim_Obj objPtr,
802	829	Jim_Obj keyObjPtr, Jim_Obj valueObjPtr);
803	830

825	852
826	853	/* integer object */
827	854	JIM_EXPORT int Jim_GetWide (Jim_Interp interp, Jim_Obj objPtr,
	855	jim_wide *widePtr);
	856	JIM_EXPORT int Jim_GetWideExpr(Jim_Interp interp, Jim_Obj objPtr,
828	857	jim_wide *widePtr);
829	858	JIM_EXPORT int Jim_GetLong (Jim_Interp interp, Jim_Obj objPtr,
830	859	long *longPtr);

864	893	JIM_EXPORT int Jim_SetAssocData(Jim_Interp interp, const char key,
865	894	Jim_InterpDeleteProc delProc, void data);
866	895	JIM_EXPORT int Jim_DeleteAssocData(Jim_Interp interp, const char key);
	896	JIM_EXPORT int Jim_CheckAbiVersion(Jim_Interp *interp, int abi_version);
867	897
868	898	/* Packages C API */
	899
869	900	/* jim-package.c */
870	901	JIM_EXPORT int Jim_PackageProvide (Jim_Interp *interp,
871	902	const char name, const char ver, int flags);
872	903	JIM_EXPORT int Jim_PackageRequire (Jim_Interp *interp,
873	904	const char *name, int flags);
	905	#define Jim_PackageProvideCheck(INTERP, NAME) \
	906	if (Jim_CheckAbiVersion(INTERP, JIM_ABI_VERSION) == JIM_ERR \|\| Jim_PackageProvide(INTERP, NAME, "1.0", JIM_ERRMSG)) \
	907	return JIM_ERR
874	908
875	909	/* error messages */
876	910	JIM_EXPORT void Jim_MakeErrorMessage (Jim_Interp *interp);

883	917	JIM_EXPORT void Jim_HistorySetCompletion(Jim_Interp interp, Jim_Obj commandObj);
884	918	JIM_EXPORT void Jim_HistoryAdd(const char *line);
885	919	JIM_EXPORT void Jim_HistoryShow(void);
	920	JIM_EXPORT void Jim_HistorySetMaxLen(int length);
	921	JIM_EXPORT int Jim_HistoryGetMaxLen(void);
886	922
887	923	/* Misc */
888	924	JIM_EXPORT int Jim_InitStaticExtensions(Jim_Interp *interp);

+348

-146

jim_tcl.txt less more

2	2
3	3	NAME
4	4	----
5		Jim Tcl v0.79 - reference manual for the Jim Tcl scripting language
	5	Jim Tcl v0.81 - reference manual for the Jim Tcl scripting language
6	6
7	7	SYNOPSIS
8	8	--------

30	30	a significant subset of the Tcl 8.6 command set, plus additional features
31	31	available only in Jim Tcl.
32	32
33		Some notable differences with Tcl 8.5/8.6 are:
	33	Some notable differences with Tcl 8.5/8.6/8.7 are:
34	34
35	35	1. Object-based I/O (aio), but with a Tcl-compatibility layer
36	36	2. I/O: Support for sockets and pipes including udp, unix domain sockets and IPv6

51	51
52	52	RECENT CHANGES
53	53	--------------
	54	Changes between 0.80 and 0.81
	55	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	56	1. TIP 582, comments allowed in expressions
	57	2. Many commands now accept "safe" integer expressions rather than simple integers:
	58	`loop`, `range`, `incr`, `string repeat`, `lrepeat`, `pack`, `unpack`, `rand`
	59	3. String and list indexes now accept integer expressions (<<_string_and_list_index_specifications,STRING AND LIST INDEX SPECIFICATIONS>>)
	60	4. `loop` can now omit the start value
	61	5. Add the `xtrace` command for execution trace support
	62	6. Add `history keep`
	63	7. Add support for `lsearch -index` and `lsearch -stride`, the latter per TIP 351
	64	8. `lsort -index` now supports multiple indices
	65	9. Add support for `lsort -stride`
	66	10. `open` now supports POSIX-style access arguments
	67	11. TIP 526, `expr` now only allows a single argument (unless --compat is enabled)
	68
	69	Changes between 0.79 and 0.80
	70	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
	71	1. `regsub` now fully supports +{backslash}A+
	72	2. Add `socket pty` to create a pseudo-tty pair
	73	3. Null characters (\x00) are now supported in variable and proc names
	74	4. dictionaries and arrays now preserve insertion order, matching Tcl and the documentation
	75	5. Add `dict getwithdefault` (and the alias `dict getdef`) per TIP 342
	76	6. Add string comparison operators (lt, gt, le, ge) per TIP 461
	77	7. Implement 0d radix prefix for decimal per TIP 472
	78
54	79	Changes between 0.78 and 0.79
55	80	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
56	81	1. Add `file mtimeus` for high resolution file timestamps

637	662	The index may be one of the following forms:
638	663
639	664	+integer+::
640		A simple integer, where '0' refers to the first element of the string
	665	A simple integer, where +0+ refers to the first element of the string
641	666	or list.
642	667
643		+integer+integer+ or::
644		+integer-integer+::
645		The sum or difference of the two integers. e.g. +2+3+ refers to the 5th element.
646		This is useful when used with (e.g.) +$i+1+ rather than the more verbose
647		+[expr {$i+1\}]+
648
649		+end+::
	668	+integerexpression+::
	669	Any "safe" expression that evaluates to an integer. A "safe" expression does not perform
	670	variable or command subsitution, but is otherwise like a normal expression
	671	(see <<_expressions,EXPRESSIONS>>).
	672
	673	::
	674	For example +1+23+ is valid integer expression, but +{$x2-1}+ is not.
	675	But note that it is possible to use an unbraced expression to allow the Tcl interpreter
	676	to expand variables and commands before being parsed as an integer expression.
	677
	678	::
	679	e.g. +string repeat a $x*2-1+
	680
	681	+end+::
650	682	The last element of the string or list.
651	683
652		+end-integer+::
653		The 'nth-from-last' element of the string or list.
	684	+end-integer+::
	685	+end-integerexpression+::
	686	+end+integerexpression+::
	687	The 'nth-from-last' element of the string or list. Again, a "safe" integer expression
	688	may be used in place of a simple integer. +end-3+ or +end-3+2*$n+. Normally it only makes
	689	sense to use the +end-+ form, but if the integer expression is negative, the +end++ form
	690	may be used.
654	691
655	692	COMMAND SUMMARY
656	693	---------------

714	751	parentheses; it is ignored by the expression processor.
715	752	Where possible, operands are interpreted as integer values.
716	753
717		Integer values may be specified in decimal (the normal case) or in
718		hexadecimal (if the first two characters of the operand are '0x').
719		Note that Jim Tcl does not treat numbers with leading zeros as octal.
	754	Comments are allowed in expressions, beginning with the '#' character
	755	and continuing until the end of line or end of expression.
	756
	757	Integer values are interpreted as decimal, binary, octal or
	758	hexadecimal if prepended with '0d', '0b', '0o' or '0x'
	759	respectively. Otherwise they are interpreted as decimal by default.
	760	(Jim Tcl does not interpret numbers with leading zeros as octal.)
720	761
721	762	If an operand does not have one of the integer formats given
722	763	above, then it is treated as a floating-point number if that is

821	862	These operators may be applied to strings as well as numeric operands,
822	863	in which case string comparison is used.
823	864
	865	+lt gt le ge+::
	866	Boolean less, greater, less than or equal, and greater than or equal.
	867	Each operator produces 1 if the condition is true, 0 otherwise.
	868	These operators differ from the above in that they use string comparison
	869	for all operands, including numeric.
	870
824	871	+== !=+::
825	872	Boolean equal and not equal. Each operator produces a zero/one result.
826	873	Valid for all operand types. Note that values will be converted to integers

1051	1098
1052	1099	REGULAR EXPRESSIONS
1053	1100	-------------------
1054		Tcl provides two commands that support string matching using regular
	1101	Jim Tcl provides two commands that support string matching using regular
1055	1102	expressions, `regexp` and `regsub`, as well as `switch -regexp` and
1056	1103	`lsearch -regexp`.
1057	1104

1087	1134	2. All Tcl character classes are supported (e.g. +[:alnum:]+, +[:digit:]+, +[:space:]+), but...
1088	1135	3. Character classes apply to ASCII characters only
1089	1136	4. Supported shorthand character classes: +{backslash}w+ = +[:alnum:]+, +{backslash}W+ = +^[:alnum:]+, +{backslash}d+ = +[:digit:],+ +{backslash}D+ = +^[:digit:],+ +{backslash}s+ = +[:space:]+, + +{backslash}S+ = +^[:space:]+
1090		5. Supported constraint escapes: +{backslash}m+ = +{backslash}<+ = start of word, +{backslash}M+ = +{backslash}>+ = end of word
	1137	5. Supported constraint escapes: +{backslash}m+ = +{backslash}<+ = start of word, +{backslash}M+ = +{backslash}>+ = end of word, +{backslash}A+ = start of string, +{backslash}Z+ = end of string
1091	1138	6. Backslash escapes may be used within regular expressions, such as +{backslash}n+ = newline, +{backslash}uNNNN+ = unicode
1092		7. Partially supported constraint escapes: +{backslash}A+ = start of string, +{backslash}Z+ = end of string
1093		8. Support for the +?+ non-greedy quantifier. e.g. +*?+
1094		9. Support for non-capturing parentheses +(?:...)+
1095		10. Jim Tcl considers that both patterns and strings end at a null character (+\x00+)
	1139	7. Support for the +?+ non-greedy quantifier. e.g. +*?+
	1140	8. Support for non-capturing parentheses +(?:...)+
	1141	9. Jim Tcl considers that both patterns and strings end at a null character (+\x00+)
	1142	10. Jim Tcl does not support back references. e.g. +{backslash}1+
	1143
	1144	STRING MATCHING
	1145	---------------
	1146	A number of commands in Jim support C-shell style "glob matching", including
	1147	`string match`, `switch -glob`, `array names` and others. This form of string matching
	1148	works as follows:
	1149
	1150	A test occurs where a +'string'+ is matched against a +'pattern'+. The match is considered
	1151	successful if the contents of +'string'+ and +'pattern'+ are identical except that the
	1152	following special sequences may appear in +'pattern'+:
	1153
	1154	+*+;;
	1155	Matches any sequence of characters in +'string'+, including an empty string.
	1156
	1157	+?+;;
	1158	Matches any single character in +'string'+.
	1159
	1160	+['chars']+;;
	1161	Matches any character in the set given by +'chars'+.
	1162	If a sequence of the form +'x-y'+ appears in +'chars'+,
	1163	then any character between +'x'+ and +'y'+, inclusive,
	1164	will match.
	1165
	1166	+{backslash}x+;;
	1167	Matches the single character +'x'+. This provides a way of
	1168	avoiding the special interpretation of the characters +{backslash}*?[]+
	1169	in +'pattern'+.
1096	1170
1097	1171	COMMAND RESULTS
1098	1172	---------------

1575	1649
1576	1650	String Matching
1577	1651	~~~~~~~~~~~~~~~
1578		Commands such as `string match`, `lsearch -glob`, `array names` and others use string
1579		pattern matching rules. These commands support UTF-8. For example:
	1652	Commands such as `string match`, `lsearch -glob`, `array names` and others use
	1653	<<_string_matching,STRING MATCHING>> rules. These commands support UTF-8. For example:
1580	1654
1581	1655	----
1582	1656	string match a\[\ua0-\ubf\]b "a\u00a3b"

1725	1799	+apply 'lambdaExpr ?arg1 arg2 \...?'+
1726	1800
1727	1801	The command `apply` provides for anonymous procedure calls,
1728		similar to `lambda`, but without command name being created, even temporarily.
1729
1730		The function +'lambdaExpr'+ is a two element list +{args body}+
1731		or a three element list +{args body namespace}+. The first element
1732		args specifies the formal arguments, in the same form as the `proc` and `lambda` commands.
	1802	similar to `lambda`, but without a command name being created, even temporarily.
	1803
	1804	The function +'lambdaExpr'+ is a two element list, +{args body}+
	1805	or a three element list, +{args body namespace}+. The first element
	1806	+'args'+ specifies the formal arguments in the same form as the `proc` and `lambda` commands.
1733	1807
1734	1808	array
1735	1809	~~~~~

1745	1819	command. The legal +'options'+ (which may be abbreviated) are:
1746	1820
1747	1821	+array exists 'arrayName'+::
1748		Returns 1 if arrayName is an array variable, 0 if there is
	1822	Returns 1 if +'arrayName'+ is an array variable, 0 if there is
1749	1823	no variable by that name.
1750	1824
1751	1825	+array get 'arrayName ?pattern?'+::
1752	1826	Returns a list containing pairs of elements. The first
1753		element in each pair is the name of an element in arrayName
	1827	element in each pair is the name of an element in +'arrayName'+
1754	1828	and the second element of each pair is the value of the
1755	1829	array element. The order of the pairs is undefined. If
1756		pattern is not specified, then all of the elements of the
1757		array are included in the result. If pattern is specified,
1758		then only those elements whose names match pattern (using
1759		the matching rules of string match) are included. If arrayName
	1830	+'pattern'+ is not specified, then all of the elements of the
	1831	array are included in the result. If +'pattern'+ is specified,
	1832	then only those elements whose names match +'pattern'+ (using
	1833	<<_string_matching,STRING MATCHING>> rules) are included. If +'arrayName'+
1760	1834	isn't the name of an array variable, or if the array contains
1761	1835	no elements, then an empty list is returned.
1762	1836
1763	1837	+array names 'arrayName ?pattern?'+::
1764	1838	Returns a list containing the names of all of the elements
1765		in the array that match pattern. If pattern is omitted then
	1839	in the array that match +'pattern'+. If +'pattern'+ is omitted then
1766	1840	the command returns all of the element names in the array.
1767		If pattern is specified, then only those elements whose
1768		names match pattern (using the matching rules of string
1769		match) are included. If there are no (matching) elements
1770		in the array, or if arrayName isn't the name of an array
	1841	If +'pattern'+ is specified, then only those elements whose
	1842	names match +'pattern'+ (using <<_string_matching,STRING MATCHING>> rules)
	1843	are included. If there are no (matching) elements
	1844	in the array, or if +'arrayName'+ isn't the name of an array
1771	1845	variable, then an empty string is returned.
1772	1846
1773	1847	+array set 'arrayName list'+::
1774		Sets the values of one or more elements in arrayName. list
	1848	Sets the values of one or more elements in +'arrayName'+. +'list'+
1775	1849	must have a form like that returned by array get, consisting
1776	1850	of an even number of elements. Each odd-numbered element
1777	1851	in list is treated as an element name within arrayName, and
1778	1852	the following element in list is used as a new value for
1779		that array element. If the variable arrayName does not
1780		already exist and list is empty, arrayName is created with
	1853	that array element. If the variable +'arrayName'+ does not
	1854	already exist and list is empty, +'arrayName'+ is created with
1781	1855	an empty array value.
1782	1856
1783	1857	+array size 'arrayName'+::
1784		Returns the number of elements in the array. If arrayName
	1858	Returns the number of elements in the array. If +'arrayName'+
1785	1859	isn't the name of an array then 0 is returned.
1786	1860
1787	1861	+array unset 'arrayName ?pattern?'+::
1788		Unsets all of the elements in the array that match pattern
1789		(using the matching rules of string match). If arrayName
	1862	Unsets all of the elements in the array that match +'pattern'+
	1863	(using <<_string_matching,STRING MATCHING>> rules). If +'arrayName'+
1790	1864	isn't the name of an array variable or there are no matching
1791		elements in the array, no error will be raised. If pattern
1792		is omitted and arrayName is an array variable, then the
	1865	elements in the array, no error will be raised. If +'pattern'+
	1866	is omitted and +'arrayName'+ is an array variable, then the
1793	1867	command unsets the entire array. The command always returns
1794	1868	an empty string.
1795	1869

1893	1967	If no format is supplied, "%c" is used.
1894	1968	::
1895	1969	If +'boolean'+ is true, processing is performed in UTC.
1896		If +'boolean'+ is false (the default), processing is performeed in the local time zone.
	1970	If +'boolean'+ is false (the default), processing is performed in the local time zone.
1897	1971
1898	1972	+clock scan 'str' -format 'format' ?-gmt 'boolean?'+::
1899	1973	Scan the given time string using the given format string.
1900	1974	See strptime(3) for supported formats.
1901	1975	See `clock format` for the handling of '-gmt'.
	1976
	1977	NOTE Some systems such as 32-bit Linux have only a 32-bit time_t, and are therefore not year 2038
	1978	compliant.
1902	1979
1903	1980	close
1904	1981	~~~~~

2003	2080	be the value for that key. It is an error to attempt to retrieve
2004	2081	a value for a key that is not present in the dictionary.
2005	2082
	2083	+dict getdef 'dictionary ?key \...? key default'+::
	2084	Alias for `dict getwithdefault`.
	2085
	2086	+dict getwithdefault 'dictionary ?key \...? key default'+::
	2087	Similar to `dict get` except if no value exists in the dictionary for the
	2088	give key(s), returns +'default'+ instead.
	2089
2006	2090	+dict keys 'dictionary ?pattern?'+::
2007	2091	Returns a list of the keys in the dictionary.
2008		If pattern is specified, then only those keys whose
2009		names match +'pattern'+ (using the matching rules of string
2010		match) are included.
	2092	If +'pattern'+ is specified, then only those keys whose
	2093	names match +'pattern'+ (using <<_string_matching,STRING MATCHING>> rules)
	2094	are included.
2011	2095
2012	2096	+dict merge ?'dictionary \...'?+::
2013	2097	Return a dictionary that contains the contents of each of the

2708	2792	The value of the variable must be integral.
2709	2793
2710	2794	If +'increment'+ is supplied then its value (which must be an
2711		integer) is added to the value of variable +'varName'+; otherwise
	2795	integer expression) is added to the value of variable +'varName'+; otherwise
2712	2796	1 is added to +'varName'+.
2713	2797
2714	2798	The new value is stored as a decimal string in variable +'varName'+

2746	2830	Tcl commands, including both the built-in commands written in C and
2747	2831	the command procedures defined using the `proc` command.
2748	2832	If +'pattern'+ is specified, only those names matching +'pattern'+
2749		are returned. Matching is determined using the same rules as for
2750		`string match`.
	2833	(using <<_string_matching,STRING MATCHING>> rules) are returned.
2751	2834
2752	2835	+info complete 'command' ?'missing'?+::
2753	2836	Returns 1 if +'command'+ is a complete Tcl command in the sense of

2779	2862	If +'pattern'+ isn't specified, returns a list of all the names
2780	2863	of currently-defined global variables.
2781	2864	If +'pattern'+ is specified, only those names matching +'pattern'+
2782		are returned. Matching is determined using the same rules as for
2783		`string match`.
	2865	(using <<_string_matching,STRING MATCHING>> rules) are returned.
2784	2866
2785	2867	+info hostname+::
2786	2868	An alias for `os.gethostname` for compatibility with Tcl 6.x

2803	2885	of currently-defined local variables, including arguments to the
2804	2886	current procedure, if any. Variables defined with the `global`
2805	2887	and `upvar` commands will not be returned. If +'pattern'+ is
2806		specified, only those names matching +'pattern'+ are returned.
2807		Matching is determined using the same rules as for `string match`.
	2888	specified, only those names matching +'pattern'+
	2889	(using <<_string_matching,STRING MATCHING>> rules) are returned.
2808	2890
2809	2891	+info nameofexecutable+::
2810	2892	Returns the name of the binary file from which the application

2815	2897	If +'pattern'+ isn't specified, returns a list of all the
2816	2898	names of Tcl command procedures.
2817	2899	If +'pattern'+ is specified, only those names matching +'pattern'+
2818		are returned. Matching is determined using the same rules as for
2819		`string match`.
	2900	(using <<_string_matching,STRING MATCHING>> rules) are returned.
2820	2901
2821	2902	+info references+::
2822	2903	Returns a list of all references which have not yet been garbage

2859	2940	returns a list of all the names of currently-visible variables, including
2860	2941	both locals and currently-visible globals.
2861	2942	If +'pattern'+ is specified, only those names matching +'pattern'+
2862		are returned. Matching is determined using the same rules as for
2863		`string match`.
	2943	(using <<_string_matching,STRING MATCHING>> rules) are returned.
2864	2944
2865	2945	join
2866	2946	~~~~

2951	3031	+local 'cmd ?arg\...?'+
2952	3032
2953	3033	First, `local` evaluates +'cmd'+ with the given arguments. The return value must
2954		be the name of an existing command, which is marked as having local scope.
	3034	be the name of an existing command, which is then marked as having local scope.
2955	3035	This means that when the current procedure exits, the specified
2956	3036	command is deleted. This can be useful with `lambda`, local procedures or
2957	3037	to automatically close a filehandle.
2958	3038
2959		In addition, if a command already exists with the same name,
2960		the existing command will be kept rather than deleted, and may be called
	3039	In addition, if a the command already exists with the same name,
	3040	the existing command will be kept rather than being deleted, and may be called
2961	3041	via `upcall`. The previous command will be restored when the current
2962	3042	procedure exits. See `upcall` for more details.
2963	3043

2992	3072	}
2993	3073	----
2994	3074
	3075	Also see `defer` as another mechanism for cleaning up at the end of a procedure.
	3076
2995	3077	loop
2996	3078	~~~~
2997		+loop 'var first limit ?incr? body'+
	3079	+loop 'var ?first? limit ?incr? body'+
2998	3080
2999	3081	Similar to `for` except simpler and possibly more efficient.
3000		With a positive increment, equivalent to:
	3082	If +'incr'+ is positive, the effect is, equivalent to:
3001	3083
3002	3084	----
3003	3085	for {set var $first} {$var < $limit} {incr var $incr} $body
3004	3086	----
3005	3087
	3088	While if +'incr'+ is negative, the count is downwards.
	3089
	3090	If +'first'+ is not specified, 0 is used.
3006	3091	If +'incr'+ is not specified, 1 is used.
3007	3092	Note that setting the loop variable inside the loop does not
3008	3093	affect the loop count.
	3094
	3095	+'first'+, +'limit'+ and +'incr'+ may be any integer expression.
3009	3096
3010	3097	lindex
3011	3098	~~~~~~

3078	3165	~~~~~~~
3079	3166	+llength 'list'+
3080	3167
3081		Treats +'list'+ as a list and returns a decimal string giving
3082		the number of elements in it.
	3168	Treats +'list'+ as a list and returns the number of elements in that list.
3083	3169
3084	3170	lset
3085	3171	~~~~

3090	3176	The `lset` command accepts a parameter, +'varName'+, which it interprets
3091	3177	as the name of a variable containing a Tcl list. It also accepts
3092	3178	zero or more indices into the list. Finally, it accepts a new value
3093		for an element of varName. If no indices are presented, the command
	3179	for an element of +'varName'+. If no indices are presented, the command
3094	3180	takes the form:
3095	3181
3096	3182	----

3098	3184	----
3099	3185
3100	3186	In this case, newValue replaces the old value of the variable
3101		varName.
	3187	+'varName'+.
3102	3188
3103	3189	When presented with a single index, the `lset` command
3104		treats the content of the varName variable as a Tcl list. It addresses
	3190	treats the content of the +'varName'+ variable as a Tcl list. It addresses
3105	3191	the index'th element in it (0 refers to the first element of the
3106	3192	list). When interpreting the list, `lset` observes the same rules
3107	3193	concerning braces and quotes and backslashes as the Tcl command
3108	3194	interpreter; however, variable substitution and command substitution
3109	3195	do not occur. The command constructs a new list in which the
3110	3196	designated element is replaced with newValue. This new list is
3111		stored in the variable varName, and is also the return value from
	3197	stored in the variable +'varName'+, and is also the return value from
3112	3198	the `lset` command.
3113	3199
3114	3200	If index is negative or greater than or equal to the number of
3115		elements in $varName, then an error occurs.
	3201	elements in +$varName+, then an error occurs.
3116	3202
3117	3203	See <<_string_and_list_index_specifications,STRING AND LIST INDEX SPECIFICATIONS>> for all allowed forms for +'index'+.
3118	3204

3252	3338	This is the default.
3253	3339
3254	3340	+-glob+::
3255		+'pattern'+ is a glob-style pattern which is matched against each list element using the same
3256		rules as the string match command.
	3341	+'pattern'+ is a glob-style pattern which is matched against each list element using
	3342	<<_string_matching,STRING MATCHING>> rules.
3257	3343
3258	3344	+-regexp+::
3259	3345	+'pattern'+ is treated as a regular expression and matched against each list element using
3260		the rules described by `regexp`.
	3346	<<_regular_expressions,REGULAR EXPRESSIONS>> rules.
3261	3347
3262	3348	+-command 'cmdname'+::
3263	3349	+'cmdname'+ is a command which is used to match the pattern against each element of the

3290	3376	+-nocase+::
3291	3377	Causes comparisons to be handled in a case-insensitive manner.
3292	3378
	3379	+-index 'indexList'+::
	3380	This option is designed for use when searching within nested lists. The
	3381	'indexList' gives a path of indices (much as might be used with
	3382	the lindex or lset commands) within each element to allow the location
	3383	of the term being matched against.
	3384
	3385	+-stride 'strideLength'+::
	3386	If this option is specified, the list is treated as consisting of
	3387	groups of 'strideLength' elements and the groups are searched by
	3388	either their first element or, if the +-index+ option is used,
	3389	by the element within each group given by the first index passed to
	3390	+-index+ (which is then ignored by +-index+). The resulting
	3391	index always points to the first element in a group.
	3392	::
	3393	The list length must be an integer multiple of 'strideLength', which
	3394	in turn must be at least 1. A 'strideLength' of 1 is the default and
	3395	indicates no grouping.
	3396
3293	3397	lsort
3294	3398	~~~~~
3295		+lsort ?-index 'listindex'? ?-nocase\|-integer\|-real\|-command 'cmdname'? ?-unique? ?-decreasing\|-increasing? 'list'+
	3399	+lsort '?options? list'+
3296	3400
3297	3401	Sort the elements of +'list'+, returning a new list in sorted order.
3298	3402	By default, ASCII (or UTF-8) sorting is used, with the result in increasing order.
3299	3403
3300		If +-nocase+ is specified, comparisons are case-insensitive.
3301
3302		If +-integer+ is specified, numeric sorting is used.
3303
3304		If +-real+ is specified, floating point number sorting is used.
3305
3306		If +-command 'cmdname'+ is specified, +'cmdname'+ is treated as a command
3307		name. For each comparison, +'cmdname $value1 $value2+' is called which
3308		should compare the values and return an integer less than, equal
3309		to, or greater than zero if the +'$value1'+ is to be considered less
3310		than, equal to, or greater than +'$value2'+, respectively.
3311
3312		If +-decreasing+ is specified, the resulting list is in the opposite
3313		order to what it would be otherwise. +-increasing+ is the default.
3314
3315		If +-unique+ is specified, then only the last set of duplicate elements found in the list will be retained.
3316		Note that duplicates are determined relative to the comparison used in the sort. Thus if +-index 0+ is used,
3317		+{1 a}+ and +{1 b}+ would be considered duplicates and only the second element, +{1 b}+, would be retained.
3318
3319		If +-index 'listindex'+ is specified, each element of the list is treated as a list and
3320		the given index is extracted from the list for comparison. The list index may
3321		be any valid list index, such as +1+, +end+ or +end-2+.
	3404	Note that only one sort type may be selected with +-integer+, +-real+, +-nocase+ or +-command+
	3405	with last option being used.
	3406
	3407	+-integer+::
	3408	Sort using numeric (integer) comparison.
	3409
	3410	+-real+::
	3411	Sort using floating point comparison.
	3412
	3413	+-nocase+::
	3414	Sort using using string comparison without regard for case.
	3415
	3416	+-command 'cmdname'+::
	3417	+'cmdname'+ is treated as a command name. For each comparison,
	3418	+'cmdname $value1 $value2+' is called which
	3419	should compare the values and return an integer less than, equal
	3420	to, or greater than zero if the +'$value1'+ is to be considered less
	3421	than, equal to, or greater than +'$value2'+, respectively.
	3422
	3423	+-increasing+::
	3424	The resulting list is in ascending order, from smallest/lowest to largest/highest.
	3425	This is the default and does not need to be specified.
	3426
	3427	+-decreasing+::
	3428	The resulting list is in the opposite order to what it would be otherwise.
	3429
	3430	+-unique+::
	3431	Only the last set of duplicate elements found in the list will
	3432	be retained. Note that duplicates are determined relative to the
	3433	comparison used in the sort. Thus if +-index 0+ is used, +{1 a}+ and
	3434	+{1 b}+ would be considered duplicates and only the second element,
	3435	+{1 b}+, would be retained.
	3436
	3437	+-index 'indexList'+::
	3438	This option is designed for use when sorting nested lists. The
	3439	'indexList' gives a path of indices (much as might be used with
	3440	the lindex or lset commands) within each element to specify the
	3441	value to be used for comparison.
	3442
	3443	+-stride 'strideLength'+::
	3444	If this option is specified, the list is treated as consisting of
	3445	groups of 'strideLength' elements and the groups are sorted by
	3446	either their first element or, if the +-index+ option is used,
	3447	by the element within each group given by the first index passed to
	3448	+-index+ (which is then ignored by +-index+). The resulting list
	3449	is once again a flat list.
	3450	::
	3451	The list length must be an integer multiple of 'strideLength', which
	3452	in turn must be at least 2.
3322	3453
3323	3454	defer
3324	3455	~~~~~

3376	3507	to the end of the file.
3377	3508
3378	3509	+'access'+ defaults to 'r'.
	3510
	3511	Additionally, if POSIX mode is supported by the underlying system,
	3512	then access may insted of consistent of a list of any of the following
	3513	flags, all of which have the standard POSIX meanings. In this case,
	3514	the first flag must be one of RDONLY, WRONLY or RDWR.
	3515
	3516	+RDONLY+::
	3517	Open the file for reading only.
	3518
	3519	+WRONLY+::
	3520	Open the file for writing only.
	3521
	3522	+RDWR+::
	3523	Open the file for both reading and writing.
	3524
	3525	+APPEND+::
	3526	Set the file pointer to the end of the file prior to each write.
	3527
	3528	+BINARY+::
	3529	Ignored.
	3530
	3531	+CREAT+::
	3532	Create the file if it does not already exist (without this flag
	3533	it is an error for the file not to exist).
	3534
	3535	+EXCL+::
	3536	If CREAT is also specified, an error is returned if the file
	3537	already exists.
	3538
	3539	+NOCTTY+::
	3540	If the file is a terminal device, this flag prevents the file
	3541	from becoming the controlling terminal of the process.
	3542
	3543	+TRUNC+::
	3544	If the file exists it is truncated to zero length.
3379	3545
3380	3546	If a file is opened for both reading and writing, then `seek`
3381	3547	must be invoked between a read and a write, or vice versa.

3402	3568	+package provide 'name ?version?'+
3403	3569
3404	3570	Indicates that the current script provides the package named +'name'+.
3405		If no version is specified, '1.0' is used.
3406
3407		Any script which provides a package may include this statement
	3571	Note: The supplied version is ignored. All packages are registered as version 1.0
	3572	(it is simply accepted for compatibility purposes).
	3573
	3574	Any script that provides a package may include this statement
3408	3575	as the first statement, although it is not required.
3409	3576
3410		+package require 'name ?version?'*+
	3577	+package require 'name ?version?'+
3411	3578
3412	3579	Searches for the package with the given +'name'+ by examining each path
3413	3580	in '$::auto_path' and trying to load '$path/$name.so' as a dynamic extension,

3421	3588
3422	3589	If `load` or `source` fails, `package require` will fail immediately.
3423	3590	No further attempt will be made to locate the file.
	3591
	3592	+package names+
	3593
	3594	Returns a list of all known/loaded packages, including internal packages.
3424	3595
3425	3596	pid
3426	3597	~~~

3447	3618	If specified, +'statics'+, declares static variables which are bound to the
3448	3619	procedure.
3449	3620
3450		See <<_procedures,PROCEDURES> for detailed information about Tcl procedures.
	3621	See <<_procedures,PROCEDURES>> for detailed information about Tcl procedures.
3451	3622
3452	3623	The `proc` command returns +'name'+ (which is useful with `local`).
3453	3624

3527	3698	7 5
3528	3699	----
3529	3700
	3701	Integer parameters may be any integer expression.
	3702
3530	3703	read
3531	3704	~~~~
3532	3705	+read ?-nonewline? 'fileId'+

3536	3709	+read 'fileId numBytes'+
3537	3710
3538	3711	+'fileId' read 'numBytes'+
	3712
	3713	+read ?-pending? 'fileId'+
	3714
	3715	+'fileId' read ?-pending?+
3539	3716
3540	3717	In the first form, all of the remaining bytes are read from the file
3541	3718	given by +'fileId'+; they are returned as the result of the command.

3546	3723	exactly this many bytes will be read and returned, unless there are fewer than
3547	3724	+'numBytes'+ bytes left in the file; in this case, all the remaining
3548	3725	bytes are returned.
	3726
	3727	The third form is currently only useful with SSL sockets. It reads at least 1 byte
	3728	and then any additional data that is buffered. This allows for use in an event handler.
	3729	e.g.
	3730
	3731	----
	3732	$sock readable {
	3733	set buf [$sock read -pending]
	3734	}
	3735	----
	3736
	3737	This is necessary because otherwise pending data may be buffered, but
	3738	the underlying socket will not be marked 'readable'. This featured is not
	3739	currently supported for regular sockets, and so these sockets must be
	3740	set to unbufferred (+$sock buffering false+) to work in an event loop.
3549	3741
3550	3742	+'fileId'+ must be +stdin+ or the return value from a previous call
3551	3743	to `open`; it must refer to a file that was opened for reading.

3591	3783	Use newline-sensitive matching. By default, newline
3592	3784	is a completely ordinary character with no special meaning in
3593	3785	either REs or strings. With this flag, +[^+ bracket expressions
3594		and +.+ never match newline, an +^+ anchor matches the null
	3786	and +.+ never match newline, an +^+ anchor matches the empty
3595	3787	string after any newline in the string in addition to its normal
3596		function, and the +$+ anchor matches the null string before any
	3788	function, and the +$+ anchor matches the empty string before any
3597	3789	newline in the string in addition to its normal function.
3598	3790
3599	3791	+-indices+::

3683	3875	Use newline-sensitive matching. By default, newline
3684	3876	is a completely ordinary character with no special meaning in
3685	3877	either REs or strings. With this flag, +[^+ bracket expressions
3686		and +.+ never match newline, an +^+ anchor matches the null
	3878	and +.+ never match newline, an +^+ anchor matches the empty
3687	3879	string after any newline in the string in addition to its normal
3688		function, and the +$+ anchor matches the null string before any
	3880	function, and the +$+ anchor matches the empty string before any
3689	3881	newline in the string in addition to its normal function.
3690	3882
3691	3883	+-start 'offset'+::

4122	4314	it will return the string +02c322c222c+.
4123	4315
4124	4316	+string match ?-nocase? 'pattern string'+::
4125		See if +'pattern'+ matches +'string'+; return 1 if it does, 0
4126		if it doesn't. Matching is done in a fashion similar to that
4127		used by the C-shell. For the two strings to match, their contents
4128		must be identical except that the following special sequences
4129		may appear in +'pattern'+:
4130
4131		+*+;;
4132		Matches any sequence of characters in +'string'+,
4133		including a null string.
4134
4135		+?+;;
4136		Matches any single character in +'string'+.
4137
4138		+['chars']+;;
4139		Matches any character in the set given by +'chars'+.
4140		If a sequence of the form +'x-y'+ appears in +'chars'+,
4141		then any character between +'x'+ and +'y'+, inclusive,
4142		will match.
4143
4144		+{backslash}x+;;
4145		Matches the single character +'x'+. This provides a way of
4146		avoiding the special interpretation of the characters +{backslash}*?[]+
4147		in +'pattern'+.
4148		::
4149		Performs a case-insensitive comparison if +-nocase+ is specified.
	4317	See if +'pattern'+ matches +'string'+ according to
	4318	<<_string_matching,STRING MATCHING>> rules
	4319	; return 1 if it does, 0
	4320	if it doesn't. The match is performed in a case-insensitive manner if +-nocase+ is specified.
4150	4321
4151	4322	+string range 'string first last'+::
4152	4323	Returns a range of consecutive characters from +'string'+, starting

4262	4433
4263	4434	+-glob+::
4264	4435	When matching string to the patterns, use glob-style
4265		matching (i.e. the same as implemented by the string
4266		match command).
	4436	<<_string_matching,STRING MATCHING>> rules.
4267	4437
4268	4438	+-regexp+::
4269		When matching string to the patterns, use regular
4270		expression matching (i.e. the same as implemented
4271		by the regexp command).
	4439	When matching string to the patterns, use
	4440	<<_regular_expressions,REGULAR EXPRESSIONS>> rules.
4272	4441
4273	4442	+-command 'commandname'+::
4274	4443	When matching string to the patterns, use the given command, which

4647	4816
4648	4817	The `while` command always returns an empty string.
4649	4818
	4819	xtrace
	4820	~~~~~~
	4821	+xtrace 'command'+
	4822
	4823	Install an execution trace callback command. This is useful for implementing a debugger
	4824	or tracing tool. On each command invocation, the given command is invoked as:
	4825
	4826	----
	4827	command proc\|cmd filename line result command arglist
	4828	----
	4829
	4830	+'proc'+ or +'cmd'+ indicates whether a command or a proc body is being executed.
	4831	+'filename'+ and +'line'+ indicate the location where the command was invoked.
	4832	+'result'+ is the current interpreter result (from the previous command).
	4833	+'command'+ and +'arglist'+ indicate the command being executed.
	4834
	4835	While the callback is executing, any further execution traces are temporarily disabled.
	4836	If the callback returns +JIM_OK+ or +JIM_RETURN+, the execution trace is reinstalled. Otherwise
	4837	the execution trace is removed.
	4838
	4839	If +xtrace+ is called with an empty argument (""), any existing callback is removed.
	4840
4650	4841	OPTIONAL-EXTENSIONS
4651	4842	-------------------
4652	4843

4739	4930	+$handle puts ?-nonewline? 'str'+::
4740	4931	Write the string, with newline unless -nonewline
4741	4932
4742		+$handle read ?-nonewline? '?len?'+::
4743		Read and return bytes from the stream. To eof if no len.
	4933	+$handle read ?-nonewline\|-pending\|len?'+::
	4934	Read and return bytes from the stream. To eof if no len. See `read`.
4744	4935
4745	4936	+$handle recvfrom 'maxlen ?addrvar?'+::
4746	4937	Receives a message from the handle via recvfrom(2) and returns it.

4777	4968	+$handle tty ?settings?+::
4778	4969	If no arguments are given, returns a dictionary containing the tty settings for the stream.
4779	4970	If arguments are given, they must either be a dictionary, or +setting value \...+
4780		Abbrevations are supported for both settings and values, so the following is acceptable:
	4971	Abbreviations are supported for both settings and values, so the following is acceptable:
4781	4972	+$f tty parity e input c out raw+.
4782	4973	Only available on platforms that support 'termios(3)'. Supported settings are:
4783	4974

4813	5004	+vtime 'time'+;;
4814	5005	Timeout for noncanonical read (units of 0.1 seconds)
4815	5006
4816		+$handle ssl ?-server 'cert priv'?+::
	5007	+$handle ssl ?-server 'cert ?key?'\|-sni 'servername'?+::
4817	5008	Upgrades the stream to a SSL/TLS session and returns the handle.
	5009	If +-server+ is specified, either both the certificate and private key files
	5010	must be specified, or a single file must be specified containing both.
	5011	If +-server+ is not specified, the connection is a client connection. In this case
	5012	+-sni+ may be specified if required to set the Server Name Indication.
4818	5013
4819	5014	+$handle unlock+::
4820	5015	Release a POSIX lock previously acquired by `aio lock`.

4943	5138	+socket pair+::
4944	5139	A socketpair (see socketpair(2)). Like `pipe`, this command returns
4945	5140	a list of two channels: {s1 s2}. These channels are both readable and writable.
	5141
	5142	+socket pty+::
	5143	A pseudo-tty pair (see openpty(3)). Like `pipe`, this command returns
	5144	a list of two channels: {master slave}. These channels are both readable and writable.
4946	5145
4947	5146	This command creates a socket connected (client) or bound (server) to the given
4948	5147	address.

5060	5259
5061	5260	+inflate 'data' '?bufferSize?'+::
5062	5261	Decompresses a raw, Deflate-compressed stream. When the uncompressed data size is known and specified, memory
5063		allocation is more efficient. Otherwise, decomperssion is chunked and therefore slower.
	5262	allocation is more efficient. Otherwise, decompression is chunked and therefore slower.
5064	5263
5065	5264	+gzip 'string' '?-level level?'+::
5066	5265	Compresses a buffer and adds a gzip header.

5219	5418	+history add 'line'+::
5220	5419	Adds the given line to the history buffer.
5221	5420
	5421	+history keep '?count?'+::
	5422	Set or return the maximum history size. Defaults to 100.
	5423
5222	5424	+history save 'filename'+::
5223	5425	Saves the current history buffer to the given file.
5224	5426

5269	5471
5270	5472	+interp+::
5271	5473	Creates and returns a new interpreter object (command).
5272		The created interpeter contains any built-in commands along with static extensions,
	5474	The created interpreter contains any built-in commands along with static extensions,
5273	5475	but does not include any dynamically loaded commands (package require, load).
5274	5476	These must be reloaded in the child interpreter if required.
5275	5477
5276	5478	+$interp delete+::
5277		Deletes the interpeter object.
	5479	Deletes the interpreter object.
5278	5480
5279	5481	+$interp eval 'script' ...+::
5280	5482	Evaluates a script in the context for the child interpreter, in the same way as 'eval'.

+466

-0

jimdb less more

	0	#!/usr/bin/env jimsh
	1	# vim:se syntax=tcl:
	2	#
	3	# A simple command line debugger for Jim Tcl.
	4
	5	set opt_trace 0
	6
	7	set argv [lassign $argv argv0]
	8	if {[string match -t* $argv0]} {
	9	set opt_trace 1
	10	set argv [lassign $argv argv0]
	11	}
	12
	13	if {$argv0 eq ""} {
	14	stderr puts "Usage: jimdb ?-trace? script ?args ...?"
	15	exit 1
	16	}
	17
	18	puts "Jim Tcl debugger v1.0 - Use ? for help\n"
	19
	20	# --- debugger implementation ---
	21	proc debugger::w {&s} {
	22	set n 0
	23	foreach t $s(stacktrace) {
	24	lassign $t f l p args
	25	set args [debugger::_squash $args]
	26	if {$f eq ""} {
	27	set loc ""
	28	} else {
	29	set loc " @ $f:$l"
	30	}
	31	puts [format "%s #%s %s" $($n == $s(level) ? ">" : " ") $n "$p $args $loc"]
	32	incr n
	33	}
	34	}
	35
	36	proc debugger::? {&s {cmd ""}} {
	37	set help {
	38	s {s "step into" "Step to the next command"}
	39	w {w "where (stacktrace)" "Displays the current stack trace. The current frame is identified with >"}
	40	n {n "step over" "Step to the next command without entering procs"}
	41	l {"l [loc]" "list source" "Lists source code. loc may be filename, filename:line, line, procname"}
	42	r {r "step out" "Continue until the current proc exits"}
	43	v {v "local vars" "Display all local variables in the current frame"}
	44	c {c "continue" "Continue until a breakpoint or ^C"}
	45	u {u "up stack frame" "Move up stack frame (towards #0)"}
	46	p {"p [expr]" "print" "Prints an expression (or variable). e.g. p x, p \$x / 3"}
	47	d {d "down stack frame" "Move down stack frame (away from #0)"}
	48	b {"b [loc]" "breakpoints" "List breakpoints (no args), or set a breakpoint at filename:line, line or procname"}
	49	t {"t [0\|1\|2]" "trace" "Toggle command tracing on/off, or sets given trace mode"}
	50	? {"? [cmd]" "help" "Display general help or for the given command"}
	51	q {q "quit" "Quit the script"}
	52	}
	53	if {$cmd eq ""} {
	54	foreach {cmd1 info1 cmd2 info2} $help {
	55	lassign $info1 u1 desc1
	56	lassign $info2 u2 desc2
	57	puts [format " %-9s %-20s %-9s %-20s" $u1 $desc1 $u2 $desc2]
	58	}
	59	} elseif {[exists help($cmd)]} {
	60	lassign $help($cmd) u desc detail
	61	puts "$u $detail"
	62	} else {
	63	puts "No such command: $cmd"
	64	}
	65	}
	66
	67	proc debugger::c {&s} {
	68	return -code break
	69	}
	70
	71	proc debugger::p {&s expr} {
	72	if {[catch {uplevel #$s(level) [list expr $expr]} msg]} {
	73	if {[uplevel #$s(level) exists $expr]} {
	74	puts "p \$$expr"
	75	catch {uplevel #$s(level) [list set $expr]} msg
	76	}
	77	}
	78	return $msg
	79	}
	80
	81	proc debugger::q {&s} {
	82	exit 0
	83	}
	84
	85	proc debugger::b {&s {loc ""}} {
	86	if {$loc eq ""} {
	87	foreach bp [lsort [dict keys $s(bplines)]] {
	88	puts "Breakpoint at [dict get $s bplines $bp] ($bp)"
	89	}
	90	foreach bp [lsort [dict keys $s(bpprocs)]] {
	91	puts "Breakpoint at $bp"
	92	}
	93	return
	94	}
	95	lassign [debugger::_findloc s $loc 0] file line
	96	if {$file ne ""} {
	97	dict set s(bplines) $file:$line $loc
	98	puts "Breakpoint at $file:$line"
	99	} else {
	100	set procs [lsort [info procs $loc]]
	101	if {[llength $procs] > 5} {
	102	puts "Too many matches: $procs"
	103	} elseif {[llength $procs] == 0} {
	104	dict set s(bpprocs) $loc 1
	105	puts "Breakpoint at $loc (future)"
	106	} else {
	107	foreach p $procs {
	108	lassign [debugger::_findloc s $p] file line
	109	dict set s(bpprocs) $p $file:$line
	110	puts "Breakpoint at $p ($file:$line)"
	111	}
	112	}
	113	}
	114	return
	115	}
	116
	117	proc debugger::n {&s} {
	118	set s(bplevel) $s(blevel)
	119	return -code break
	120	}
	121
	122	proc debugger::r {&s} {
	123	incr s(bplevel) -1
	124	return -code break
	125	}
	126
	127	proc debugger::s {&s} {
	128	set s(bpany) 1
	129	return -code break
	130	}
	131
	132	proc debugger::v {&s {pat *}} {
	133	set level #$s(level)
	134	if {$s(level) == 0} {
	135	set vars [info globals $pat]
	136	} else {
	137	set vars [uplevel $level info locals $pat]
	138	}
	139	foreach i [lsort $vars] {
	140	puts "$i = [debugger::_squash [uplevel $level set $i]]"
	141	}
	142	}
	143
	144	proc debugger::u {&s} {
	145	if {$s(level) > 0} {
	146	incr s(level) -1
	147	}
	148	tailcall debugger::w s
	149	}
	150
	151	proc debugger::d {&s} {
	152	if {$s(level) < [info level] - 2} {
	153	incr s(level)
	154	}
	155	tailcall debugger::w s
	156	}
	157
	158	proc debugger::t {&s {mode {}}} {
	159	if {$mode eq ""} {
	160	set mode $(!$s(trace))
	161	}
	162	switch -exact -- $mode {
	163	0 {
	164	set msg off
	165	}
	166	1 {
	167	set msg on
	168	}
	169	2 {
	170	set msg full
	171	}
	172	default {
	173	error "Unknown trace mode: $mode"
	174	}
	175	}
	176	set s(trace) $mode
	177	puts "Tracing is now $msg"
	178	}
	179
	180	proc debugger::l {&s {loc {}}} {
	181	if {$loc eq ""} {
	182	lassign $s(active) file line
	183	if {$file eq ""} {
	184	return "No source location available"
	185	}
	186	} else {
	187	lassign [debugger::_findloc s $loc] file line
	188	}
	189	if {$file eq ""} {
	190	return "Don't know anything about: $loc"
	191	}
	192	puts "@ $file"
	193	debugger::_showlines s $file $line 8
	194	set s(lastcmd) "l $file:$($line + 8)"
	195	return
	196	}
	197
	198	# ----- internal commands below this point -----
	199
	200	# This proc can be overridden to read commands from
	201	# some other location, such as remote socket
	202	proc debugger::_getcmd {&s &cmd} {
	203	if {![exists s(historyfile)]} {
	204	set s(historyfile) [env HOME]/.jimdb_history
	205	history load $s(historyfile)
	206	}
	207	while 1 {
	208	if {[history getline "dbg> " cmd] < 0} {
	209	signal default SIGINT
	210	puts "Use q to quit, ? for help"
	211	set cmd ""
	212	return 0
	213	}
	214	if {$cmd eq "h"} {
	215	history show
	216	continue
	217	}
	218	# Don't bother adding single char commands to the history
	219	if {[string length $cmd] > 1} {
	220	history add $cmd
	221	history save $s(historyfile)
	222	}
	223	return 1
	224	}
	225	}
	226
	227	proc debugger::?? {&s} {
	228	parray s
	229	return ""
	230	}
	231
	232	proc debugger::_squash {arglist} {
	233	set arglist [regsub -all "\[\n\t\r \]+" $arglist { }]
	234	if {[string length $arglist] > 60} {
	235	set arglist [string range $arglist 0 57]...
	236	}
	237	return $arglist
	238	}
	239
	240	# Converts something which looks like a location into a file/line
	241	# number -> file=active, line=number
	242	# filename -> file=filename, line=1
	243	# filename:number -> file=filename, line=number
	244	# procname -> file, line = of first line of body
	245	proc debugger::_findloc {&s loc {checkproc 1}} {
	246	lassign $s(active) afile aline
	247	if {[string is integer -strict $loc]} {
	248	set result [list $afile $loc]
	249	} else {
	250	if {[string match : $loc]} {
	251	regexp (.):(.) $loc -> file line
	252	} else {
	253	set file $loc
	254	set line 1
	255	}
	256	if {[file exists $file]} {
	257	set result [list $file $line]
	258	} elseif {$checkproc && [exists -proc $loc]} {
	259	set result [info source [info body $loc]]
	260	} else {
	261	set result ""
	262	}
	263	}
	264	return $result
	265	}
	266
	267	proc debugger::_showlines {&s file line context} {
	268	lassign $s(active) afile aline
	269	if {[catch {
	270	set file [debugger::_findfile $file]
	271	set f [open $file]
	272	set file [file tail $file]
	273	set afile [file tail $afile]
	274	set n 0
	275	set lines [split [$f read] \n]
	276	if {$line >= [llength $lines]} {
	277	set line [llength $lines]
	278	}
	279	foreach l $lines {
	280	incr n
	281	if {$n > $line + $context} {
	282	break
	283	}
	284	if {$n >= $line - $context} {
	285	if {$n == $aline && $file eq $afile} {
	286	set marker ">"
	287	} elseif {$n == $line} {
	288	set marker "*"
	289	} else {
	290	set marker " "
	291	}
	292	puts [format "%s%4d %s" $marker $n $l]
	293	}
	294	}
	295	$f close
	296	} msg]} {
	297	puts $msg
	298	}
	299	}
	300
	301	proc debugger::_showloc {&s file line name arglist} {
	302	set tail [file tail $file]
	303	if {$file eq ""} {
	304	puts "@ $name [debugger::_squash $arglist]"
	305	} else {
	306	puts "@ $tail:$line $name [debugger::_squash $arglist]"
	307	debugger::_showlines s $file $line 1
	308	}
	309	}
	310
	311	proc debugger::_checkbp {&s file line name} {
	312	if {[signal check -clear SIGINT] ne ""} {
	313	return 1
	314	}
	315	if {$s(bpany) == 0} {
	316	return 1
	317	}
	318	# We don't want to stop on the same line with a different command
	319	# when stepping with 'n'. This isn't perfect since the same
	320	# command might be part of a nested expression, but we have no additional
	321	# information available.
	322	if {$s(laststop) eq "$file:$line" && $s(prevname) ne $name} {
	323	return 0
	324	}
	325	if {$s(blevel) <= $s(bplevel)} {
	326	return 1
	327	}
	328	if {[dict exists $s(bplines) $file:$line]} {
	329	puts "Breakpoint @ $file:$line"
	330	return 1
	331	}
	332	return 0
	333	}
	334
	335	proc debugger::_findfile {filename} {
	336	# Search for the given file in likely places
	337	foreach dir [list {*}$::auto_path . [file dirname $::argv0] [file dirname [info nameofexecutable]]] {
	338	if {[file exists $dir/$filename]} {
	339	return $dir/$filename
	340	}
	341	}
	342	return $filename
	343	}
	344
	345	# The execution trace (xtrace) callback
	346	proc debugger::_db {type file line result name arglist} {
	347	upvar #0 debugger::state s
	348
	349	#puts "@ $file:$line ($result) $type $name [debugger::_squash $arglist]"
	350
	351	# proc is only used to activate breakpoints
	352	if {$type eq "proc"} {
	353	# If we aren't already going to stop at the next command
	354	# do so if we have a proc breakpoint
	355	if {$s(bpany) != 1} {
	356	set s(bpany) [dict exists $s bpprocs $name]
	357	}
	358	return
	359	}
	360
	361	# level is the proc frame level
	362	set s(level) $([info level] - 1)
	363	# blevel is the breakpoint level for n, r commands
	364	set s(blevel) [info level]
	365	set s(active) [list $file $line $name $arglist]
	366
	367	incr s(bpany) -1
	368
	369	if {[catch -nobreak -noreturn {
	370	if {[debugger::_checkbp s $file $line $name]} {
	371	# Breakpoint here
	372	set s(bpany) 0
	373	set s(bplevel) -1
	374	set s(laststop) $file:$line
	375	set s(prevname) $name
	376
	377	# Build the active stacktrace
	378	set s(stacktrace) {}
	379	foreach level [range 1 [info level]] {
	380	lassign [info frame $level] p f l
	381	lassign [info level $level] p pargs
	382	lappend s(stacktrace) [list $f $l $p $pargs]
	383	}
	384	lappend s(stacktrace) $s(active)
	385
	386	if {$result ne ""} {
	387	puts "=> [debugger::_squash $result]"
	388	}
	389	debugger::_showloc s $file $line $name $arglist
	390
	391	set buf {}
	392	while {1} {
	393	set rc [debugger::_getcmd s buf]
	394	if {$rc == -1} {
	395	# Stop tracing
	396	return
	397	}
	398	if {$buf eq ""} {
	399	set buf $s(lastcmd)
	400	} else {
	401	set s(lastcmd) $buf
	402	}
	403
	404	# Mark the active stack frame
	405	set s(active) [lindex $s(stacktrace) $s(level)]
	406
	407	set args [lassign $buf cmd]
	408	catch -nobreak {
	409	if {[exists -proc debugger::$cmd]} {
	410	debugger::$cmd s {*}$args
	411	} else {
	412	uplevel #$s(level) $buf
	413	}
	414	} result
	415	if {$result ne ""} {
	416	puts $result
	417	}
	418	}
	419	} elseif {$s(trace) && $file ne ""} {
	420	if {$s(trace) == 2 && $result ne ""} {
	421	puts "=> [debugger::_squash $result]"
	422	}
	423	if {$file ne $s(lastsource)} {
	424	puts "@ $file"
	425	}
	426	set s(lastsource) $file
	427	debugger::_showlines s $file $line 0
	428	}
	429	} err opts]} {
	430	puts [errorInfo $err]
	431	exit 1
	432	}
	433	}
	434
	435	# Allows a breakpoint to be manually inserted
	436	# The message is for documentation purposes
	437	proc breakpoint {{msg ""}} {
	438	set ::debugger::state(bpany) 1
	439	}
	440
	441	signal ignore SIGINT
	442
	443	set debugger::state {
	444	bplevel -1
	445	bpany -1
	446	bplines {}
	447	bpprocs {}
	448	lastcmd ""
	449	laststop ""
	450	level 0
	451	trace 0
	452	active {}
	453	prevname {}
	454	stacktrace {}
	455	lastsource {}
	456	}
	457
	458	set debugger::state(trace) $opt_trace
	459	# Break at the very next command after source
	460	set debugger::state(bpany) 2
	461
	462	# Install the debugger
	463	xtrace debugger::_db
	464
	465	source $argv0

+19

-11

jimiocompat.h less more

7	7
8	8	#include <stdio.h>
9	9	#include <errno.h>
	10	#include <sys/stat.h>
10	11
11	12	#include "jimautoconf.h"
12	13	#include <jim.h>

60	61	#define HAVE_PIPE
61	62	#define pipe(P) _pipe((P), 0, O_NOINHERIT)
62	63
63		#elif defined(HAVE_UNISTD_H)
64		#include <unistd.h>
65		#include <fcntl.h>
66		#include <sys/wait.h>
67		#include <sys/stat.h>
	64	typedef struct _stat64 jim_stat_t;
	65	#define Jim_Stat __stat64
68	66
69		typedef int pidtype;
70		#define Jim_Errno() errno
71		#define JIM_BAD_PID -1
72		#define JIM_NO_PID 0
	67	#else
	68	typedef struct stat jim_stat_t;
	69	#define Jim_Stat stat
73	70
74		#ifndef HAVE_EXECVPE
75		#define execvpe(ARG0, ARGV, ENV) execvp(ARG0, ARGV)
	71	#if defined(HAVE_UNISTD_H)
	72	#include <unistd.h>
	73	#include <fcntl.h>
	74	#include <sys/wait.h>
	75
	76	typedef int pidtype;
	77	#define Jim_Errno() errno
	78	#define JIM_BAD_PID -1
	79	#define JIM_NO_PID 0
	80
	81	#ifndef HAVE_EXECVPE
	82	#define execvpe(ARG0, ARGV, ENV) execvp(ARG0, ARGV)
	83	#endif
76	84	#endif
77	85	#endif
78	86

+23

-7

jimregexp.c less more

230	230	* Beware that the optimization-preparation code in here knows about some
231	231	* of the structure of the compiled regexp.
232	232	*/
233		int regcomp(regex_t preg, const char exp, int cflags)
	233	int jim_regcomp(regex_t preg, const char exp, int cflags)
234	234	{
235	235	int scan;
236	236	int longest;

718	718	pattern++;
719	719	}
720	720
721		while (pattern && pattern != ']') {
	721	while (*pattern != ']') {
722	722	/* Is this a range? a-z */
723	723	int start;
724	724	int end;

729	729	CC_NUM
730	730	};
731	731	int cc;
	732
	733	if (!*pattern) {
	734	preg->err = REG_ERR_UNMATCHED_BRACKET;
	735	return 0;
	736	}
732	737
733	738	pattern += reg_utf8_tounicode_case(pattern, &start, nocase);
734	739	if (start == '\\') {

753	758	preg->err = REG_ERR_NULL_CHAR;
754	759	return 0;
755	760	}
	761	if (start == '\\' && *pattern == 0) {
	762	preg->err = REG_ERR_INVALID_ESCAPE;
	763	return 0;
	764	}
756	765	}
757	766	if (pattern[0] == '-' && pattern[1] && pattern[1] != ']') {
758	767	/* skip '-' */

762	771	pattern += reg_decode_escape(pattern, &end);
763	772	if (end == 0) {
764	773	preg->err = REG_ERR_NULL_CHAR;
	774	return 0;
	775	}
	776	if (start == '\\' && *pattern == 0) {
	777	preg->err = REG_ERR_INVALID_ESCAPE;
765	778	return 0;
766	779	}
767	780	}

868	881	ch = *preg->regparse++;
869	882	switch (ch) {
870	883	case '\0':
871		preg->err = REG_ERR_TRAILING_BACKSLASH;
	884	preg->err = REG_ERR_INVALID_ESCAPE;
872	885	return 0;
873	886	case 'A':
874	887	ret = regnode(preg, BOLX);

1100	1113	/*
1101	1114	- regexec - match a regexp against a string
1102	1115	*/
1103		int regexec(regex_t preg, const char string, size_t nmatch, regmatch_t pmatch[], int eflags)
	1116	int jim_regexec(regex_t preg, const char string, size_t nmatch, regmatch_t pmatch[], int eflags)
1104	1117	{
1105	1118	const char *s;
1106	1119	int scan;

1581	1594	}
1582	1595	return(1);
1583	1596	}
	1597	/* Restore input position after failure */
	1598	preg->reginput = save;
1584	1599	return(0);
1585	1600	}
1586	1601	return REG_ERR_INTERNAL;

1853	1868	}
1854	1869	#endif /* JIM_BOOTSTRAP */
1855	1870
1856		size_t regerror(int errcode, const regex_t preg, char errbuf, size_t errbuf_size)
	1871	size_t jim_regerror(int errcode, const regex_t preg, char errbuf, size_t errbuf_size)
1857	1872	{
1858	1873	static const char *error_strings[] = {
1859	1874	"success",

1872	1887	"nested count",
1873	1888	"internal error",
1874	1889	"count follows nothing",
1875		"trailing backslash",
	1890	"invalid escape \\ sequence",
1876	1891	"corrupted program",
1877	1892	"contains null char",
	1893	"brackets [] not balanced",
1878	1894	};
1879	1895	const char *err;
1880	1896

1888	1904	return snprintf(errbuf, errbuf_size, "%s", err);
1889	1905	}
1890	1906
1891		void regfree(regex_t *preg)
	1907	void jim_regfree(regex_t *preg)
1892	1908	{
1893	1909	free(preg->program);
1894	1910	}

-5

jimregexp.h less more

90	90	REG_ERR_NESTED_COUNT,
91	91	REG_ERR_INTERNAL,
92	92	REG_ERR_COUNT_FOLLOWS_NOTHING,
93		REG_ERR_TRAILING_BACKSLASH,
	93	REG_ERR_INVALID_ESCAPE,
94	94	REG_ERR_CORRUPTED,
95	95	REG_ERR_NULL_CHAR,
	96	REG_ERR_UNMATCHED_BRACKET,
96	97	REG_ERR_NUM
97	98	};
98	99
99		int regcomp(regex_t preg, const char regex, int cflags);
100		int regexec(regex_t preg, const char string, size_t nmatch, regmatch_t pmatch[], int eflags);
101		size_t regerror(int errcode, const regex_t preg, char errbuf, size_t errbuf_size);
102		void regfree(regex_t *preg);
	100	int jim_regcomp(regex_t preg, const char regex, int cflags);
	101	int jim_regexec(regex_t preg, const char string, size_t nmatch, regmatch_t pmatch[], int eflags);
	102	size_t jim_regerror(int errcode, const regex_t preg, char errbuf, size_t errbuf_size);
	103	void jim_regfree(regex_t *preg);
103	104
104	105	#ifdef __cplusplus
105	106	}

-1

jimsh.c less more

127	127	JimSetArgv(interp, argc - 3, argv + 3);
128	128	retcode = Jim_Eval(interp, argv[2]);
129	129	if (retcode != JIM_ERR) {
130		printf("%s\n", Jim_String(Jim_GetResult(interp)));
	130	int len;
	131	const char *msg = Jim_GetString(Jim_GetResult(interp), &len);
	132	if (fwrite(msg, len, 1, stdout) == 0) {
	133	/* nothing */
	134	}
	135	putchar('\n');
131	136	}
132	137	}
133	138	else {

+63

-70

jsonencode.tcl less more

20	20	# Top level JSON encoder which encodes the given
21	21	# value based on the schema
22	22	proc json::encode {value {schema str}} {
23		json::encode.[lindex $schema 0] $value [lrange $schema 1 end]
	23	json::subencode [lindex $schema 0] $value [lrange $schema 1 end]
24	24	}
25	25
26		# Encode a string
27		proc json::encode.str {value {dummy {}}} {
28		# Strictly we should be converting \x00 through \x1F to unicode escapes
29		# And anything outside the BMP to a UTF-16 surrogate pair
30		return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\"
31		}
	26	# encode the value according to to the given type
	27	proc json::subencode {type value {schema {}}} {
	28	switch -exact -- $type {
	29	str - "" {
	30	# Strictly we should be converting \x00 through \x1F to unicode escapes
	31	# And anything outside the BMP to a UTF-16 surrogate pair
	32	return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\"
	33	}
	34	num {
	35	if {$value in {Inf -Inf}} {
	36	append value inity
	37	}
	38	return $value
	39	}
	40	bool {
	41	if {$value} {
	42	return true
	43	}
	44	return false
	45	}
	46	obj {
	47	set result "\{"
	48	set sep " "
	49	foreach k [lsort [dict keys $value]] {
	50	if {[dict exists $schema $k]} {
	51	set subtype [dict get $schema $k]
	52	} elseif {[dict exists $schema *]} {
	53	set subtype [dict get $schema *]
	54	} else {
	55	set subtype str
	56	}
	57	append result $sep\"$k\":
32	58
33		# If no type is given, also encode as a string
34		proc json::encode. {args} {
35		tailcall json::encode.str {*}$args
36		}
37
38		# Encode a number
39		proc json::encode.num {value {dummy {}}} {
40		if {$value in {Inf -Inf}} {
41		append value inity
	59	append result [json::subencode [lindex $subtype 0] [dict get $value $k] [lrange $subtype 1 end]]
	60	set sep ", "
	61	}
	62	append result " \}"
	63	return $result
	64	}
	65	list {
	66	set result "\["
	67	set sep " "
	68	foreach l $value {
	69	append result $sep
	70	append result [json::subencode [lindex $schema 0] $l [lrange $schema 1 end]]
	71	set sep ", "
	72	}
	73	append result " \]"
	74	return $result
	75	}
	76	mixed {
	77	set result "\["
	78	set sep " "
	79	foreach l $value subtype $schema {
	80	append result $sep
	81	append result [json::subencode [lindex $subtype 0] $l [lrange $subtype 1 end]]
	82	set sep ", "
	83	}
	84	append result " \]"
	85	}
	86	default {
	87	error "bad type $type"
	88	}
42	89	}
43		return $value
44		}
45
46		# Encode a boolean
47		proc json::encode.bool {value {dummy {}}} {
48		if {$value} {
49		return true
50		}
51		return false
52		}
53
54		# Encode an object (dictionary)
55		proc json::encode.obj {obj {schema {}}} {
56		set result "\{"
57		set sep " "
58		foreach k [lsort [dict keys $obj]] {
59		if {[dict exists $schema $k]} {
60		set type [dict get $schema $k]
61		} elseif {[dict exists $schema *]} {
62		set type [dict get $schema *]
63		} else {
64		set type str
65		}
66		append result $sep\"$k\":
67
68		append result [json::encode.[lindex $type 0] [dict get $obj $k] [lrange $type 1 end]]
69		set sep ", "
70		}
71		append result " \}"
72		}
73
74		# Encode an array (list)
75		proc json::encode.list {list {type str}} {
76		set result "\["
77		set sep " "
78		foreach l $list {
79		append result $sep
80		append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]]
81		set sep ", "
82		}
83		append result " \]"
84		}
85
86		# Encode a mixed-type array (list)
87		# Must be as many types as there are elements of the list
88		proc json::encode.mixed {list types} {
89		set result "\["
90		set sep " "
91		foreach l $list type $types {
92		append result $sep
93		append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]]
94		set sep ", "
95		}
96		append result " \]"
97	90	}
98	91
99	92	# vim: se ts=4:

-2

make-c-ext.tcl less more

17	17	while {[gets $f buf] >= 0} {
18	18	# Remove comment lines
19	19	regsub {^[ \t]#.$} $buf "" buf
20		# Escape quotes and backlashes
21		set buf [string map [list \\ \\\\ \" \\"] $buf]
	20	# Escape quotes and backlashes and remove carriage returns
	21	set buf [string map [list \\ \\\\ \" \\" \r ""] $buf]
22	22	lappend sourcelines \"$buf\\n\"
23	23	}
24	24	close $f

+10

-10

oo.tcl less more

21	21
22	22	# Merge in the baseclass vars with lower precedence
23	23	set classvars [dict merge $baseclassvars $classvars]
24		set vars [lsort [dict keys $classvars]]
25	24
26	25	# This is the class dispatcher for $classname
27	26	# It simply dispatches 'classname cmd' to a procedure named {classname cmd}

39	38
40	39	# This is the object dispatcher for $classname.
41	40	# Store the classname in both the ref value and tag, for debugging
42		# ref tag (for debugging)
43		set obj [ref $classname $classname "$classname finalize"]
	41	set obj ::[ref $classname $classname "$classname finalize"]
44	42	proc $obj {method args} {classname instvars} {
45	43	if {![exists -command "$classname $method"]} {
46	44	if {![exists -command "$classname unknown"]} {

68	66	# Note that we can't use 'dict with' here because
69	67	# the dict isn't updated until the body completes.
70	68	foreach __ [$self vars] {upvar 1 instvars($__) $__}
71		unset __
	69	unset -nocomplain __
72	70	eval $__body
73	71	}
74	72	}
75	73	# Other simple class procs
76		proc "$classname vars" {} vars { return $vars }
	74	proc "$classname vars" {} classvars { lsort [dict keys $classvars] }
77	75	proc "$classname classvars" {} classvars { return $classvars }
78	76	proc "$classname classname" {} classname { return $classname }
79	77	proc "$classname methods" {} classname {

84	82	# Pre-defined some instance methods
85	83	$classname method destroy {} { rename $self "" }
86	84	$classname method get {var} { set $var }
87		$classname method eval {{locals {}} __code} {
88		foreach var $locals { upvar 2 $var $var }
89		eval $__code
	85	$classname method eval {{__locals {}} __body} {
	86	foreach __ $__locals { upvar 2 $__ $__ }
	87	unset -nocomplain __
	88	eval $__body
90	89	}
91	90	return $classname
92	91	}

94	93	# From within a method, invokes the given method on the base class.
95	94	# Note that this will only call the last baseclass given
96	95	proc super {method args} {
97		upvar self self
98		uplevel 2 [$self baseclass] $method {*}$args
	96	# If we are called from "class method", we want to call "[$class baseclass] method"
	97	set classname [lindex [info level -1] 0 0]
	98	uplevel 2 [list [$classname baseclass] $method {*}$args]
99	99	}

-0

parse-unidata.tcl less more

32	32
33	33	set f [open $unicodefile]
34	34	while {[gets $f buf] >= 0} {
	35	# Remove any trailing whitespace, especially errant CR
	36	set buf [string trim $buf]
35	37	set title ""
36	38	set lower ""
37	39	set upper ""

114	116	if {$do_width} {
115	117	set f [open $widthfile]
116	118	while {[gets $f buf] >= 0} {
	119	# Remove any trailing whitespace, especially errant CR
	120	set buf [string trim $buf]
117	121	if {[regexp {^([0-9A-Fa-f.]+);W} $buf -> range]} {
118	122	set range [string tolower $range]
119	123	lassign [split $range .] lower - upper

+11

-0

regtest.tcl less more

349	349	catch {expr {2 && "abc$"}}
350	350	puts "TEST 51 PASSED"
351	351
	352	# REGTEST 52
	353	# lsearch -command with too few args
	354	catch {lsearch -all -command abc def}
	355	puts "TEST 52 PASSED"
	356
	357	# REGTEST 53
	358	# string last with invalid index
	359	catch {string last foo bar -1}
	360	puts "TEST 53 PASSED"
	361
	362
352	363	# TAKE THE FOLLOWING puts AS LAST LINE
353	364
354	365	puts "--- ALL TESTS PASSED ---"

-4

sqlite3/Makefile less more

0	0	# Builds the full sqlite3 extension for Jim Tcl with the sqlite3 amalgamation
1	1
2		all: sqlite3.so
	2	all: sqlite.so
3	3
4	4	SQLITE3_OPTS := -DSQLITE_OMIT_LOAD_EXTENSION=1 -DSQLITE_THREADSAFE=0 -DSQLITE_DEFAULT_FILE_FORMAT=4 \
5	5	-DSQLITE_ENABLE_STAT3 -DSQLITE_ENABLE_LOCKING_STYLE=0 -DSQLITE_OMIT_INCRBLOB
6	6
7		sqlite3.so: jim-sqlite3.c sqlite3.c
	7	sqlite.so: jim-sqlite.c sqlite3.c
8	8	./build-ext -Wall -o $@ -I.. -L.. $(SQLITE3_OPTS) $(BUILDOPTS) $^
9	9
10	10	clean:
11	11	rm -f .o .so
12	12
13	13	# Note that this will only work when not cross compiling
14		test: sqlite3.so
15		../jimsh test-sqlite3.tcl
	14	test: sqlite.so
	15	../jimsh test-sqlite.tcl

-8

sqlite3/README less more

12	12
13	13	$ make
14	14
15		./build-ext -o sqlite3.so -I.. -L.. -DSQLITE_OMIT_LOAD_EXTENSION=1 ... jim-sqlite3.c sqlite3.c
16		Building sqlite3.so from jim-sqlite3.c sqlite3.c
	15	./build-ext -o sqlite.so -I.. -L.. -DSQLITE_OMIT_LOAD_EXTENSION=1 ... jim-sqlite.c sqlite3.c
	16	Building sqlite.so from jim-sqlite.c sqlite3.c
17	17
18	18	Warning: libjim is static. Dynamic module may not work on some platforms.
19	19
20		Compile: jim-sqlite3.o
	20	Compile: jim-sqlite.o
21	21	Compile: sqlite3.o
22		Link: sqlite3.so
	22	Link: sqlite.so
23	23
24	24	Success!
25	25

31	31	Installing
32	32	----------
33	33
34		Copy sqlite3.so to your jim library directory, typically /usr/local/lib/jim or
	34	Copy sqlite.so to your jim library directory, typically /usr/local/lib/jim or
35	35	where $JIMLIB points to.
36	36
37	37	Using
38	38	-----
39		In your Jim Tcl code, ensure that sqlite3.so is in a directory on $auto_path.
	39	In your Jim Tcl code, ensure that sqlite.so is in a directory on $auto_path.
40	40	Then:
41	41
42		package require sqlite3
	42	package require sqlite
43	43
44		sqlite3 db test.db
	44	sqlite db test.db
45	45	...etc..
46	46
47	47	Documentation

+2828

-0

sqlite3/jim-sqlite.c less more

	0	/* Jim Tcl version of the sqlite3 Tcl binding.
	1	* From sqlite3 3.6.22
	2	*
	3	* This version is (c) Steve Bennett <steveb@workware.net.au>
	4	* Copyright of the original version is below.
	5	*/
	6
	7	/*
	8	** 2001 September 15
	9	**
	10	** The author disclaims copyright to this source code. In place of
	11	** a legal notice, here is a blessing:
	12	**
	13	** May you do good and not evil.
	14	** May you find forgiveness for yourself and forgive others.
	15	** May you share freely, never taking more than you give.
	16	**
	17	*************************************************************************
	18	** A TCL Interface to SQLite. Append this file to sqlite3.c and
	19	** compile the whole thing to build a TCL-enabled version of SQLite.
	20	**
	21	** Compile-time options:
	22	**
	23	** -D SQLITE_TEST When used in conjuction with -DTCLSH=1, add
	24	** hundreds of new commands used for testing
	25	** SQLite. This option implies -DSQLITE_TCLMD5.
	26	*/
	27	#include <jim.h>
	28	#include <jim-config.h>
	29	#include <jim-eventloop.h>
	30	#include <errno.h>
	31
	32	/*
	33	** Some additional include files are needed if this file is not
	34	** appended to the amalgamation.
	35	*/
	36	#ifndef SQLITE_AMALGAMATION
	37	# include "sqlite3.h"
	38	# include <stdlib.h>
	39	# include <string.h>
	40	# include <assert.h>
	41	typedef unsigned char u8;
	42	#endif
	43	#include <ctype.h>
	44
	45	#define NUM_PREPARED_STMTS 10
	46	#define MAX_PREPARED_STMTS 100
	47
	48	/*
	49	** If Jim Tcl uses UTF-8 and SQLite is configured to use iso8859, then we
	50	#ifdef JIM_UTF8
	51	#define SQLITE_UTF8
	52	#endif
	53
	54	** have to do a translation when going between the two. Set the
	55	** UTF_TRANSLATION_NEEDED macro to indicate that we need to do
	56	** this translation.
	57	*/
	58	#if defined(JIM_UTF8) && !defined(SQLITE_UTF8)
	59	# define UTF_TRANSLATION_NEEDED 1
	60	# warning Jim Tcl can not translate encoding from iso8859 to utf-8
	61	#endif
	62
	63	/*
	64	** New SQL functions can be created as TCL scripts. Each such function
	65	** is described by an instance of the following structure.
	66	*/
	67	typedef struct SqlFunc SqlFunc;
	68	struct SqlFunc {
	69	Jim_Interp interp; / The TCL interpret to execute the function */
	70	Jim_Obj pScript; / The Jim_Obj representation of the script */
	71	int useEvalObjv; /* True if it is safe to use Jim_EvalObjv */
	72	char zName; / Name of this function */
	73	SqlFunc pNext; / Next function on the list of them all */
	74	};
	75
	76	/*
	77	** New collation sequences function can be created as TCL scripts. Each such
	78	** function is described by an instance of the following structure.
	79	*/
	80	typedef struct SqlCollate SqlCollate;
	81	struct SqlCollate {
	82	Jim_Interp interp; / The TCL interpret to execute the function */
	83	char zScript; / The script to be run */
	84	SqlCollate pNext; / Next function on the list of them all */
	85	};
	86
	87	/*
	88	** Prepared statements are cached for faster execution. Each prepared
	89	** statement is described by an instance of the following structure.
	90	*/
	91	typedef struct SqlPreparedStmt SqlPreparedStmt;
	92	struct SqlPreparedStmt {
	93	SqlPreparedStmt pNext; / Next in linked list */
	94	SqlPreparedStmt pPrev; / Previous on the list */
	95	sqlite3_stmt pStmt; / The prepared statement */
	96	int nSql; /* chars in zSql[] */
	97	const char zSql; / Text of the SQL statement */
	98	int nParm; /* Size of apParm array */
	99	Jim_Obj *apParm; / Array of referenced object pointers */
	100	};
	101
	102	typedef struct IncrblobChannel IncrblobChannel;
	103
	104	/*
	105	** There is one instance of this structure for each SQLite database
	106	** that has been opened by the SQLite TCL interface.
	107	*/
	108	typedef struct SqliteDb SqliteDb;
	109	struct SqliteDb {
	110	sqlite3 db; / The "real" database structure. MUST BE FIRST */
	111	Jim_Interp interp; / The interpreter used for this database */
	112	char zBusy; / The busy callback routine */
	113	char zCommit; / The commit hook callback routine */
	114	char zTrace; / The trace callback routine */
	115	char zProfile; / The profile callback routine */
	116	char zProgress; / The progress callback routine */
	117	char zAuth; / The authorization callback routine */
	118	int disableAuth; /* Disable the authorizer if it exists */
	119	char zNull; / Text to substitute for an SQL NULL value */
	120	SqlFunc pFunc; / List of SQL functions */
	121	Jim_Obj pUpdateHook; / Update hook script (if any) */
	122	Jim_Obj pRollbackHook; / Rollback hook script (if any) */
	123	Jim_Obj pUnlockNotify; / Unlock notify script (if any) */
	124	SqlCollate pCollate; / List of SQL collation functions */
	125	int rc; /* Return code of most recent sqlite3_exec() */
	126	Jim_Obj pCollateNeeded; / Collation needed script */
	127	SqlPreparedStmt stmtList; / List of prepared statements*/
	128	SqlPreparedStmt stmtLast; / Last statement in the list */
	129	int maxStmt; /* The next maximum number of stmtList */
	130	int nStmt; /* Number of statements in stmtList */
	131	IncrblobChannel pIncrblob;/ Linked list of open incrblob channels */
	132	int nStep, nSort; /* Statistics for most recent operation */
	133	int nTransaction; /* Number of nested [transaction] methods */
	134	};
	135
	136	struct IncrblobChannel {
	137	sqlite3_blob pBlob; / sqlite3 blob handle */
	138	SqliteDb pDb; / Associated database connection */
	139	int iSeek; /* Current seek offset */
	140	Jim_Obj channel; / Channel identifier */
	141	IncrblobChannel pNext; / Linked list of all open incrblob channels */
	142	IncrblobChannel pPrev; / Linked list of all open incrblob channels */
	143	};
	144
	145	/*
	146	** Compute a string length that is limited to what can be stored in
	147	** lower 30 bits of a 32-bit signed integer.
	148	*/
	149	static int strlen30(const char *z){
	150	const char *z2 = z;
	151	while( *z2 ){ z2++; }
	152	return 0x3fffffff & (int)(z2 - z);
	153	}
	154
	155
	156	#ifndef SQLITE_OMIT_INCRBLOB
	157	/*
	158	** Close all incrblob channels opened using database connection pDb.
	159	** This is called when shutting down the database connection.
	160	*/
	161	static void closeIncrblobChannels(SqliteDb *pDb){
	162	IncrblobChannel *p;
	163	IncrblobChannel *pNext;
	164
	165	for(p=pDb->pIncrblob; p; p=pNext){
	166	pNext = p->pNext;
	167
	168	/* Note: Calling unregister here call Jim_Close on the incrblob channel,
	169	** which deletes the IncrblobChannel structure at *p. So do not
	170	** call Jim_Free() here.
	171	*/
	172	Jim_UnregisterChannel(pDb->interp, p->channel);
	173	}
	174	}
	175
	176	/*
	177	** Close an incremental blob channel.
	178	*/
	179	static int incrblobClose(ClientData instanceData, Jim_Interp *interp){
	180	IncrblobChannel p = (IncrblobChannel )instanceData;
	181	int rc = sqlite3_blob_close(p->pBlob);
	182	sqlite3 *db = p->pDb->db;
	183
	184	/* Remove the channel from the SqliteDb.pIncrblob list. */
	185	if( p->pNext ){
	186	p->pNext->pPrev = p->pPrev;
	187	}
	188	if( p->pPrev ){
	189	p->pPrev->pNext = p->pNext;
	190	}
	191	if( p->pDb->pIncrblob==p ){
	192	p->pDb->pIncrblob = p->pNext;
	193	}
	194
	195	/* Free the IncrblobChannel structure */
	196	Jim_Free((char *)p);
	197
	198	if( rc!=SQLITE_OK ){
	199	Jim_SetResult(interp, (char *)sqlite3_errmsg(db), JIM_VOLATILE);
	200	return JIM_ERR;
	201	}
	202	return JIM_OK;
	203	}
	204
	205	/*
	206	** Read data from an incremental blob channel.
	207	*/
	208	static int incrblobInput(
	209	ClientData instanceData,
	210	char *buf,
	211	int bufSize,
	212	int *errorCodePtr
	213	){
	214	IncrblobChannel p = (IncrblobChannel )instanceData;
	215	int nRead = bufSize; /* Number of bytes to read */
	216	int nBlob; /* Total size of the blob */
	217	int rc; /* sqlite error code */
	218
	219	nBlob = sqlite3_blob_bytes(p->pBlob);
	220	if( (p->iSeek+nRead)>nBlob ){
	221	nRead = nBlob-p->iSeek;
	222	}
	223	if( nRead<=0 ){
	224	return 0;
	225	}
	226
	227	rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
	228	if( rc!=SQLITE_OK ){
	229	*errorCodePtr = rc;
	230	return -1;
	231	}
	232
	233	p->iSeek += nRead;
	234	return nRead;
	235	}
	236
	237	/*
	238	** Write data to an incremental blob channel.
	239	*/
	240	static int incrblobOutput(
	241	ClientData instanceData,
	242	CONST char *buf,
	243	int toWrite,
	244	int *errorCodePtr
	245	){
	246	IncrblobChannel p = (IncrblobChannel )instanceData;
	247	int nWrite = toWrite; /* Number of bytes to write */
	248	int nBlob; /* Total size of the blob */
	249	int rc; /* sqlite error code */
	250
	251	nBlob = sqlite3_blob_bytes(p->pBlob);
	252	if( (p->iSeek+nWrite)>nBlob ){
	253	*errorCodePtr = EINVAL;
	254	return -1;
	255	}
	256	if( nWrite<=0 ){
	257	return 0;
	258	}
	259
	260	rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
	261	if( rc!=SQLITE_OK ){
	262	*errorCodePtr = EIO;
	263	return -1;
	264	}
	265
	266	p->iSeek += nWrite;
	267	return nWrite;
	268	}
	269
	270	/*
	271	** Seek an incremental blob channel.
	272	*/
	273	static int incrblobSeek(
	274	ClientData instanceData,
	275	long offset,
	276	int seekMode,
	277	int *errorCodePtr
	278	){
	279	IncrblobChannel p = (IncrblobChannel )instanceData;
	280
	281	switch( seekMode ){
	282	case SEEK_SET:
	283	p->iSeek = offset;
	284	break;
	285	case SEEK_CUR:
	286	p->iSeek += offset;
	287	break;
	288	case SEEK_END:
	289	p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
	290	break;
	291
	292	default: assert(!"Bad seekMode");
	293	}
	294
	295	return p->iSeek;
	296	}
	297
	298
	299	static void incrblobWatch(ClientData instanceData, int mode){
	300	/* NO-OP */
	301	}
	302	static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){
	303	return JIM_ERR;
	304	}
	305
	306	static Jim_ChannelType IncrblobChannelType = {
	307	"incrblob", /* typeName */
	308	JIM_CHANNEL_VERSION_2, /* version */
	309	incrblobClose, /* closeProc */
	310	incrblobInput, /* inputProc */
	311	incrblobOutput, /* outputProc */
	312	incrblobSeek, /* seekProc */
	313	0, /* setOptionProc */
	314	0, /* getOptionProc */
	315	incrblobWatch, /* watchProc (this is a no-op) */
	316	incrblobHandle, /* getHandleProc (always returns error) */
	317	0, /* close2Proc */
	318	0, /* blockModeProc */
	319	0, /* flushProc */
	320	0, /* handlerProc */
	321	0, /* wideSeekProc */
	322	};
	323
	324	/*
	325	** Create a new incrblob channel.
	326	*/
	327	static int createIncrblobChannel(
	328	Jim_Interp *interp,
	329	SqliteDb *pDb,
	330	const char *zDb,
	331	const char *zTable,
	332	const char *zColumn,
	333	sqlite_int64 iRow,
	334	int isReadonly
	335	){
	336	IncrblobChannel *p;
	337	sqlite3 *db = pDb->db;
	338	sqlite3_blob *pBlob;
	339	int rc;
	340	int flags = JIM_READABLE\|(isReadonly ? 0 : JIM_WRITABLE);
	341
	342	/* This variable is used to name the channels: "incrblob_[incr count]" */
	343	static int count = 0;
	344	char zChannel[64];
	345
	346	rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
	347	if( rc!=SQLITE_OK ){
	348	Jim_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), JIM_VOLATILE);
	349	return JIM_ERR;
	350	}
	351
	352	p = (IncrblobChannel *)Jim_Alloc(sizeof(IncrblobChannel));
	353	p->iSeek = 0;
	354	p->pBlob = pBlob;
	355
	356	sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
	357	p->channel = Jim_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
	358	Jim_RegisterChannel(interp, p->channel);
	359
	360	/* Link the new channel into the SqliteDb.pIncrblob list. */
	361	p->pNext = pDb->pIncrblob;
	362	p->pPrev = 0;
	363	if( p->pNext ){
	364	p->pNext->pPrev = p;
	365	}
	366	pDb->pIncrblob = p;
	367	p->pDb = pDb;
	368
	369	Jim_SetResult(interp, (char *)Jim_GetChannelName(p->channel), JIM_VOLATILE);
	370	return JIM_OK;
	371	}
	372	#else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
	373	#define closeIncrblobChannels(pDb)
	374	#endif
	375
	376	/*
	377	** Look at the script prefix in pCmd. We will be executing this script
	378	** after first appending one or more arguments. This routine analyzes
	379	** the script to see if it is safe to use Jim_EvalObjv() on the script
	380	** rather than the more general Jim_EvalEx(). Jim_EvalObjv() is much
	381	** faster.
	382	**
	383	** Scripts that are safe to use with Jim_EvalObjv() consists of a
	384	** command name followed by zero or more arguments with no [...] or $
	385	** or {...} or ; to be seen anywhere. Most callback scripts consist
	386	** of just a single procedure name and they meet this requirement.
	387	*/
	388	static int safeToUseEvalObjv(Jim_Interp interp, Jim_Obj pCmd){
	389	/* We could try to do something with Jim_Parse(). But we will instead
	390	** just do a search for forbidden characters. If any of the forbidden
	391	** characters appear in pCmd, we will report the string as unsafe.
	392	*/
	393	const char *z;
	394	int n;
	395	z = Jim_GetString(pCmd, &n);
	396	while( n-- > 0 ){
	397	int c = *(z++);
	398	if( c=='$' \|\| c=='[' \|\| c==';' ) return 0;
	399	}
	400	return 1;
	401	}
	402
	403	/*
	404	** Find an SqlFunc structure with the given name. Or create a new
	405	** one if an existing one cannot be found. Return a pointer to the
	406	** structure.
	407	*/
	408	static SqlFunc findSqlFunc(SqliteDb pDb, const char *zName){
	409	SqlFunc p, pNew;
	410	int i;
	411	pNew = (SqlFunc)Jim_Alloc( sizeof(pNew) + strlen30(zName) + 1 );
	412	pNew->zName = (char*)&pNew[1];
	413	for(i=0; zName[i]; i++){ pNew->zName[i] = tolower((unsigned)zName[i]); }
	414	pNew->zName[i] = 0;
	415	for(p=pDb->pFunc; p; p=p->pNext){
	416	if( strcmp(p->zName, pNew->zName)==0 ){
	417	Jim_Free((char*)pNew);
	418	return p;
	419	}
	420	}
	421	pNew->interp = pDb->interp;
	422	pNew->pScript = 0;
	423	pNew->pNext = pDb->pFunc;
	424	pDb->pFunc = pNew;
	425	return pNew;
	426	}
	427
	428	/*
	429	** Finalize and free a list of prepared statements
	430	*/
	431	static void flushStmtCache( SqliteDb *pDb ){
	432	SqlPreparedStmt *pPreStmt;
	433
	434	while( pDb->stmtList ){
	435	sqlite3_finalize( pDb->stmtList->pStmt );
	436	pPreStmt = pDb->stmtList;
	437	pDb->stmtList = pDb->stmtList->pNext;
	438	Jim_Free( (char*)pPreStmt );
	439	}
	440	pDb->nStmt = 0;
	441	pDb->stmtLast = 0;
	442	}
	443
	444	/*
	445	** TCL calls this procedure when an sqlite3 database command is
	446	** deleted.
	447	*/
	448	static void DbDeleteCmd(Jim_Interp interp, void db){
	449	SqliteDb pDb = (SqliteDb)db;
	450	flushStmtCache(pDb);
	451	closeIncrblobChannels(pDb);
	452	sqlite3_close(pDb->db);
	453	while( pDb->pFunc ){
	454	SqlFunc *pFunc = pDb->pFunc;
	455	pDb->pFunc = pFunc->pNext;
	456	Jim_DecrRefCount(interp, pFunc->pScript);
	457	Jim_Free((char*)pFunc);
	458	}
	459	while( pDb->pCollate ){
	460	SqlCollate *pCollate = pDb->pCollate;
	461	pDb->pCollate = pCollate->pNext;
	462	Jim_Free((char*)pCollate);
	463	}
	464	if( pDb->zBusy ){
	465	Jim_Free(pDb->zBusy);
	466	}
	467	if( pDb->zTrace ){
	468	Jim_Free(pDb->zTrace);
	469	}
	470	if( pDb->zProfile ){
	471	Jim_Free(pDb->zProfile);
	472	}
	473	if( pDb->zAuth ){
	474	Jim_Free(pDb->zAuth);
	475	}
	476	if( pDb->zNull ){
	477	Jim_Free(pDb->zNull);
	478	}
	479	if( pDb->pUpdateHook ){
	480	Jim_DecrRefCount(interp, pDb->pUpdateHook);
	481	}
	482	if( pDb->pRollbackHook ){
	483	Jim_DecrRefCount(interp, pDb->pRollbackHook);
	484	}
	485	if( pDb->pCollateNeeded ){
	486	Jim_DecrRefCount(interp, pDb->pCollateNeeded);
	487	}
	488	Jim_Free((char*)pDb);
	489	}
	490
	491	/*
	492	** This routine is called when a database file is locked while trying
	493	** to execute SQL.
	494	*/
	495	static int DbBusyHandler(void *cd, int nTries){
	496	SqliteDb pDb = (SqliteDb)cd;
	497	int rc;
	498	char zVal[30];
	499	Jim_Obj *objPtr;
	500
	501	sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
	502
	503	objPtr = Jim_NewStringObj(pDb->interp, pDb->zBusy, -1);
	504	Jim_AppendStrings(pDb->interp, objPtr, " ", zVal, NULL);
	505	rc = Jim_EvalObj(pDb->interp, objPtr);
	506	if( rc!=JIM_OK \|\| atoi(Jim_String(Jim_GetResult(pDb->interp))) ){
	507	return 0;
	508	}
	509	return 1;
	510	}
	511
	512	#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
	513	/*
	514	** This routine is invoked as the 'progress callback' for the database.
	515	*/
	516	static int DbProgressHandler(void *cd){
	517	SqliteDb pDb = (SqliteDb)cd;
	518	int rc;
	519
	520	assert( pDb->zProgress );
	521	rc = Jim_Eval(pDb->interp, pDb->zProgress);
	522	if( rc!=JIM_OK \|\| atoi(Jim_String(Jim_GetResult(pDb->interp))) ){
	523	return 1;
	524	}
	525	return 0;
	526	}
	527	#endif
	528
	529	#ifndef SQLITE_OMIT_TRACE
	530	/*
	531	** This routine is called by the SQLite trace handler whenever a new
	532	** block of SQL is executed. The TCL script in pDb->zTrace is executed.
	533	*/
	534	static void DbTraceHandler(void cd, const char zSql){
	535	SqliteDb pDb = (SqliteDb)cd;
	536
	537	Jim_Obj *str = Jim_NewStringObj(pDb->interp, pDb->zTrace, -1);
	538	Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zSql, -1));
	539	Jim_Eval(pDb->interp, zSql);
	540	Jim_SetEmptyResult(pDb->interp);
	541	}
	542	#endif
	543
	544	#ifndef SQLITE_OMIT_TRACE
	545	/*
	546	** This routine is called by the SQLite profile handler after a statement
	547	** SQL has executed. The TCL script in pDb->zProfile is evaluated.
	548	*/
	549	static void DbProfileHandler(void cd, const char zSql, sqlite_uint64 tm){
	550	SqliteDb pDb = (SqliteDb)cd;
	551	Jim_Obj *str;
	552	char zTm[100];
	553
	554	sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
	555	str = Jim_NewStringObj(pDb->interp, pDb->zProfile, -1);
	556	Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zSql, -1));
	557	Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zTm, -1));
	558	Jim_EvalObj(pDb->interp, str);
	559	Jim_SetEmptyResult(pDb->interp);
	560	}
	561	#endif
	562
	563	/*
	564	** This routine is called when a transaction is committed. The
	565	** TCL script in pDb->zCommit is executed. If it returns non-zero or
	566	** if it throws an exception, the transaction is rolled back instead
	567	** of being committed.
	568	*/
	569	static int DbCommitHandler(void *cd){
	570	SqliteDb pDb = (SqliteDb)cd;
	571	int rc;
	572
	573	rc = Jim_Eval(pDb->interp, pDb->zCommit);
	574	if( rc!=JIM_OK \|\| atoi(Jim_String(Jim_GetResult(pDb->interp))) ){
	575	return 1;
	576	}
	577	return 0;
	578	}
	579
	580	static void DbRollbackHandler(void *clientData){
	581	SqliteDb pDb = (SqliteDb)clientData;
	582	assert(pDb->pRollbackHook);
	583	Jim_EvalObjBackground(pDb->interp, pDb->pRollbackHook);
	584	}
	585
	586	#if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
	587	static void setTestUnlockNotifyVars(Jim_Interp *interp, int iArg, int nArg){
	588	char zBuf[64];
	589	sprintf(zBuf, "%d", iArg);
	590	Jim_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, JIM_GLOBAL_ONLY);
	591	sprintf(zBuf, "%d", nArg);
	592	Jim_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, JIM_GLOBAL_ONLY);
	593	}
	594	#else
	595	# define setTestUnlockNotifyVars(x,y,z)
	596	#endif
	597
	598	#ifdef SQLITE_ENABLE_UNLOCK_NOTIFY
	599	static void DbUnlockNotify(void **apArg, int nArg){
	600	int i;
	601	for(i=0; i<nArg; i++){
	602	const int flags = (JIM_EVAL_GLOBAL\|JIM_EVAL_DIRECT);
	603	SqliteDb pDb = (SqliteDb )apArg[i];
	604	setTestUnlockNotifyVars(pDb->interp, i, nArg);
	605	assert( pDb->pUnlockNotify);
	606	Jim_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);
	607	Jim_DecrRefCount(interp, pDb->pUnlockNotify);
	608	pDb->pUnlockNotify = 0;
	609	}
	610	}
	611	#endif
	612
	613	static void DbUpdateHandler(
	614	void *p,
	615	int op,
	616	const char *zDb,
	617	const char *zTbl,
	618	sqlite_int64 rowid
	619	){
	620	SqliteDb pDb = (SqliteDb )p;
	621	Jim_Obj *pCmd;
	622
	623	assert( pDb->pUpdateHook );
	624	assert( op==SQLITE_INSERT \|\| op==SQLITE_UPDATE \|\| op==SQLITE_DELETE );
	625
	626	pCmd = Jim_DuplicateObj(pDb->interp, pDb->pUpdateHook);
	627	Jim_IncrRefCount(pCmd);
	628	Jim_ListAppendElement(0, pCmd, Jim_NewStringObj(pDb->interp,
	629	( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1));
	630	Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewStringObj(pDb->interp, zDb, -1));
	631	Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewStringObj(pDb->interp, zTbl, -1));
	632	Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewIntObj(pDb->interp, rowid));
	633	Jim_EvalObj(pDb->interp, pCmd);
	634	}
	635
	636	static void tclCollateNeeded(
	637	void *pCtx,
	638	sqlite3 *db,
	639	int enc,
	640	const char *zName
	641	){
	642	SqliteDb pDb = (SqliteDb )pCtx;
	643	Jim_Obj *pScript = Jim_DuplicateObj(pDb->interp, pDb->pCollateNeeded);
	644	//Jim_IncrRefCount(pScript);
	645	Jim_ListAppendElement(pDb->interp, pScript, Jim_NewStringObj(pDb->interp, zName, -1));
	646	Jim_EvalObj(pDb->interp, pScript);
	647	//Jim_DecrRefCount(pDb->interp, pScript);
	648	}
	649
	650	/*
	651	** This routine is called to evaluate an SQL collation function implemented
	652	** using TCL script.
	653	*/
	654	static int tclSqlCollate(
	655	void *pCtx,
	656	int nA,
	657	const void *zA,
	658	int nB,
	659	const void *zB
	660	){
	661	SqlCollate p = (SqlCollate )pCtx;
	662	Jim_Obj *pCmd;
	663
	664	pCmd = Jim_NewStringObj(p->interp, p->zScript, -1);
	665	//Jim_IncrRefCount(pCmd);
	666	Jim_ListAppendElement(p->interp, pCmd, Jim_NewStringObj(p->interp, zA, nA));
	667	Jim_ListAppendElement(p->interp, pCmd, Jim_NewStringObj(p->interp, zB, nB));
	668	Jim_EvalObj(p->interp, pCmd);
	669	//Jim_DecrRefCount(interp, pCmd);
	670	return (atoi(Jim_String(Jim_GetResult(p->interp))));
	671	}
	672
	673	/*
	674	** This routine is called to evaluate an SQL function implemented
	675	** using TCL script.
	676	*/
	677	static void tclSqlFunc(sqlite3_context context, int argc, sqlite3_value*argv){
	678	SqlFunc *p = sqlite3_user_data(context);
	679	Jim_Obj *pCmd;
	680	int i;
	681	int rc;
	682
	683	if( argc==0 ){
	684	/* If there are no arguments to the function, call Jim_EvalObjEx on the
	685	** script object directly. This allows the TCL compiler to generate
	686	** bytecode for the command on the first invocation and thus make
	687	** subsequent invocations much faster. */
	688	pCmd = p->pScript;
	689	//Jim_IncrRefCount(pCmd);
	690	rc = Jim_EvalObj(p->interp, pCmd);
	691	//Jim_DecrRefCount(interp, pCmd);
	692	}else{
	693	/* If there are arguments to the function, make a shallow copy of the
	694	** script object, lappend the arguments, then evaluate the copy.
	695	**
	696	** By "shallow" copy, we mean a only the outer list Jim_Obj is duplicated.
	697	** The new Jim_Obj contains pointers to the original list elements.
	698	** That way, when Jim_EvalObjv() is run and shimmers the first element
	699	** of the list to tclCmdNameType, that alternate representation will
	700	** be preserved and reused on the next invocation.
	701	*/
	702	pCmd = Jim_DuplicateObj(p->interp, p->pScript);
	703	Jim_IncrRefCount(pCmd);
	704	for(i=0; i<argc; i++){
	705	sqlite3_value *pIn = argv[i];
	706	Jim_Obj *pVal;
	707
	708	/* Set pVal to contain the i'th column of this row. */
	709	switch( sqlite3_value_type(pIn) ){
	710	case SQLITE_BLOB: {
	711	int bytes = sqlite3_value_bytes(pIn);
	712	pVal = Jim_NewStringObj(p->interp, sqlite3_value_blob(pIn), bytes);
	713	break;
	714	}
	715	case SQLITE_INTEGER: {
	716	sqlite_int64 v = sqlite3_value_int64(pIn);
	717	pVal = Jim_NewIntObj(p->interp, v);
	718	break;
	719	}
	720	case SQLITE_FLOAT: {
	721	double r = sqlite3_value_double(pIn);
	722	pVal = Jim_NewDoubleObj(p->interp, r);
	723	break;
	724	}
	725	case SQLITE_NULL: {
	726	pVal = Jim_NewStringObj(p->interp, "", 0);
	727	break;
	728	}
	729	default: {
	730	int bytes = sqlite3_value_bytes(pIn);
	731	pVal = Jim_NewStringObj(p->interp, (char *)sqlite3_value_text(pIn), bytes);
	732	break;
	733	}
	734	}
	735	Jim_ListAppendElement(p->interp, pCmd, pVal);
	736	}
	737	if( !p->useEvalObjv ){
	738	/* Jim_EvalOb() will automatically call Jim_EvalObjVector() if pCmd
	739	** is a list without a string representation. To prevent this from
	740	** happening, make sure pCmd has a valid string representation */
	741	Jim_String(pCmd);
	742	}
	743	rc = Jim_EvalObj(p->interp, pCmd);
	744	Jim_DecrRefCount(p->interp, pCmd);
	745	}
	746
	747	if( rc && rc!=JIM_RETURN ){
	748	sqlite3_result_error(context, Jim_String(Jim_GetResult(p->interp)), -1);
	749	}else{
	750	Jim_Obj *pVar = Jim_GetResult(p->interp);
	751	int n;
	752	u8 *data;
	753	/* XXX: Jim Tcl doesn't have bytearray or boolean */
	754	const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
	755	char c = zType[0];
	756	#if 0
	757	if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
	758	/* Only return a BLOB type if the Tcl variable is a bytearray and
	759	** has no string representation. */
	760	data = Jim_GetByteArrayFromObj(pVar, &n);
	761	sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
	762	}else if( c=='b' && strcmp(zType,"boolean")==0 ){
	763	Jim_GetWide(0, pVar, &n);
	764	sqlite3_result_int(context, n);
	765	}else
	766	#endif
	767	if( c=='d' && strcmp(zType,"double")==0 ){
	768	double r;
	769	Jim_GetDouble(0, pVar, &r);
	770	sqlite3_result_double(context, r);
	771	/* XXX: Is a cooerced double better as a double or an int? */
	772	}else if( (c=='c' && strcmp(zType,"coerced-double")==0) \|\|
	773	(c=='i' && strcmp(zType,"int")==0) ){
	774	jim_wide v;
	775	Jim_GetWide(p->interp, pVar, &v);
	776	sqlite3_result_int64(context, v);
	777	}else{
	778	data = (unsigned char *)Jim_GetString(pVar, &n);
	779	sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
	780	}
	781	}
	782	}
	783
	784	#ifndef SQLITE_OMIT_AUTHORIZATION
	785	/*
	786	** This is the authentication function. It appends the authentication
	787	** type code and the two arguments to zCmd[] then invokes the result
	788	** on the interpreter. The reply is examined to determine if the
	789	** authentication fails or succeeds.
	790	*/
	791	static int auth_callback(
	792	void *pArg,
	793	int code,
	794	const char *zArg1,
	795	const char *zArg2,
	796	const char *zArg3,
	797	const char *zArg4
	798	){
	799	char *zCode;
	800	Jim_Obj *str;
	801	int rc;
	802	const char *zReply;
	803	SqliteDb pDb = (SqliteDb)pArg;
	804	if( pDb->disableAuth ) return SQLITE_OK;
	805
	806	switch( code ){
	807	case SQLITE_COPY : zCode="SQLITE_COPY"; break;
	808	case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;
	809	case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;
	810	case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
	811	case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
	812	case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
	813	case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
	814	case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;
	815	case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;
	816	case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;
	817	case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;
	818	case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;
	819	case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;
	820	case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;
	821	case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
	822	case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;
	823	case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;
	824	case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;
	825	case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;
	826	case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;
	827	case SQLITE_READ : zCode="SQLITE_READ"; break;
	828	case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;
	829	case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;
	830	case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;
	831	case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;
	832	case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;
	833	case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break;
	834	case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break;
	835	case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break;
	836	case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break;
	837	case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break;
	838	case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break;
	839	case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break;
	840	default : zCode="????"; break;
	841	}
	842	str = Jim_NewStringObj(pDb->interp, pDb->zAuth, -1);
	843	/* XXX: list or string here? */
	844	Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zCode, -1));
	845	if (zArg1) {
	846	Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg1, -1));
	847	}
	848	if (zArg2) {
	849	Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg2, -1));
	850	}
	851	if (zArg3) {
	852	Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg3, -1));
	853	}
	854	if (zArg4) {
	855	Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg4, -1));
	856	}
	857	Jim_IncrRefCount(str);
	858	rc = Jim_EvalGlobal(pDb->interp, Jim_String(str));
	859	Jim_DecrRefCount(pDb->interp, str);
	860	zReply = Jim_String(Jim_GetResult(pDb->interp));
	861	if( strcmp(zReply,"SQLITE_OK")==0 ){
	862	rc = SQLITE_OK;
	863	}else if( strcmp(zReply,"SQLITE_DENY")==0 ){
	864	rc = SQLITE_DENY;
	865	}else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
	866	rc = SQLITE_IGNORE;
	867	}else{
	868	rc = 999;
	869	}
	870	return rc;
	871	}
	872	#endif /* SQLITE_OMIT_AUTHORIZATION */
	873
	874	/*
	875	** Note that Jim Tcl can't do encoding conversion,
	876	** so this simply returns the string as an object.
	877	*/
	878	static Jim_Obj dbTextToObj(Jim_Interp interp, char const *zText){
	879	return Jim_NewStringObj(interp, zText ? zText : "", -1);
	880	}
	881
	882	/*
	883	** This routine reads a line of text from FILE in, stores
	884	** the text in memory obtained from malloc() and returns a pointer
	885	** to the text. NULL is returned at end of file.
	886	**
	887	** The interface is like "readline" but no command-line editing
	888	** is done.
	889	**
	890	** copied from shell.c from '.import' command
	891	*/
	892	static char local_getline(char zPrompt, FILE *in){
	893	char *zLine;
	894	int nLine;
	895	int n;
	896	int eol;
	897
	898	nLine = 100;
	899	zLine = Jim_Alloc( nLine );
	900	n = 0;
	901	eol = 0;
	902	while( !eol ){
	903	if( n+100>nLine ){
	904	nLine = nLine*2 + 100;
	905	zLine = Jim_Realloc(zLine, nLine);
	906	if( zLine==0 ) return 0;
	907	}
	908	if( fgets(&zLine[n], nLine - n, in)==0 ){
	909	if( n==0 ){
	910	Jim_Free(zLine);
	911	return 0;
	912	}
	913	zLine[n] = 0;
	914	eol = 1;
	915	break;
	916	}
	917	while( zLine[n] ){ n++; }
	918	if( n>0 && zLine[n-1]=='\n' ){
	919	n--;
	920	zLine[n] = 0;
	921	eol = 1;
	922	}
	923	}
	924	zLine = Jim_Realloc( zLine, n+1 );
	925	return zLine;
	926	}
	927
	928
	929	/*
	930	** This function is part of the implementation of the command:
	931	**
	932	** $db transaction [-deferred\|-immediate\|-exclusive] SCRIPT
	933	**
	934	** It is invoked after evaluating the script SCRIPT to commit or rollback
	935	** the transaction or savepoint opened by the [transaction] command.
	936	*/
	937	static int DbTransPostCmd(
	938	Jim_Interp interp, / Tcl interpreter */
	939	SqliteDb *pDb,
	940	int result /* Result of evaluating SCRIPT */
	941	){
	942	static const char *azEnd[] = {
	943	"RELEASE _tcl_transaction", /* rc==JIM_ERR, nTransaction!=0 */
	944	"COMMIT", /* rc!=JIM_ERR, nTransaction==0 */
	945	"ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction",
	946	"ROLLBACK" /* rc==JIM_ERR, nTransaction==0 */
	947	};
	948	int rc = result;
	949	const char *zEnd;
	950
	951	pDb->nTransaction--;
	952	zEnd = azEnd[(rc==JIM_ERR)*2 + (pDb->nTransaction==0)];
	953
	954	pDb->disableAuth++;
	955	if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
	956	/* This is a tricky scenario to handle. The most likely cause of an
	957	** error is that the exec() above was an attempt to commit the
	958	** top-level transaction that returned SQLITE_BUSY. Or, less likely,
	959	** that an IO-error has occured. In either case, throw a Tcl exception
	960	** and try to rollback the transaction.
	961	**
	962	** But it could also be that the user executed one or more BEGIN,
	963	** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
	964	** this method's logic. Not clear how this would be best handled.
	965	*/
	966	if( rc!=JIM_ERR ){
	967	Jim_AppendString(interp, Jim_GetResult(interp), sqlite3_errmsg(pDb->db), -1);
	968	rc = JIM_ERR;
	969	}
	970	sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
	971	}
	972	pDb->disableAuth--;
	973
	974	return rc;
	975	}
	976
	977	/*
	978	** Search the cache for a prepared-statement object that implements the
	979	** first SQL statement in the buffer pointed to by parameter zIn. If
	980	** no such prepared-statement can be found, allocate and prepare a new
	981	** one. In either case, bind the current values of the relevant Tcl
	982	** variables to any $var, :var or @var variables in the statement. Before
	983	** returning, set *ppPreStmt to point to the prepared-statement object.
	984	**
	985	** Output parameter *pzOut is set to point to the next SQL statement in
	986	** buffer zIn, or to the '\0' byte at the end of zIn if there is no
	987	** next statement.
	988	**
	989	** If successful, JIM_OK is returned. Otherwise, JIM_ERR is returned
	990	** and an error message loaded into interpreter pDb->interp.
	991	*/
	992	static int dbPrepareAndBind(
	993	SqliteDb pDb, / Database object */
	994	char const zIn, / SQL to compile */
	995	char const *pzOut, / OUT: Pointer to next SQL statement */
	996	SqlPreparedStmt *ppPreStmt / OUT: Object used to cache statement */
	997	){
	998	const char zSql = zIn; / Pointer to first SQL statement in zIn */
	999	sqlite3_stmt pStmt; / Prepared statement object */
	1000	SqlPreparedStmt pPreStmt; / Pointer to cached statement */
	1001	int nSql; /* Length of zSql in bytes */
	1002	int nVar; /* Number of variables in statement */
	1003	int iParm = 0; /* Next free entry in apParm */
	1004	int i;
	1005	Jim_Interp *interp = pDb->interp;
	1006
	1007	*ppPreStmt = 0;
	1008
	1009	/* Trim spaces from the start of zSql and calculate the remaining length. */
	1010	while( isspace((unsigned)zSql[0]) ){ zSql++; }
	1011	nSql = strlen30(zSql);
	1012
	1013	for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
	1014	int n = pPreStmt->nSql;
	1015	if( nSql>=n
	1016	&& memcmp(pPreStmt->zSql, zSql, n)==0
	1017	&& (zSql[n]==0 \|\| zSql[n-1]==';')
	1018	){
	1019	pStmt = pPreStmt->pStmt;
	1020	*pzOut = &zSql[pPreStmt->nSql];
	1021
	1022	/* When a prepared statement is found, unlink it from the
	1023	** cache list. It will later be added back to the beginning
	1024	** of the cache list in order to implement LRU replacement.
	1025	*/
	1026	if( pPreStmt->pPrev ){
	1027	pPreStmt->pPrev->pNext = pPreStmt->pNext;
	1028	}else{
	1029	pDb->stmtList = pPreStmt->pNext;
	1030	}
	1031	if( pPreStmt->pNext ){
	1032	pPreStmt->pNext->pPrev = pPreStmt->pPrev;
	1033	}else{
	1034	pDb->stmtLast = pPreStmt->pPrev;
	1035	}
	1036	pDb->nStmt--;
	1037	nVar = sqlite3_bind_parameter_count(pStmt);
	1038	break;
	1039	}
	1040	}
	1041
	1042	/* If no prepared statement was found. Compile the SQL text. Also allocate
	1043	** a new SqlPreparedStmt structure. */
	1044	if( pPreStmt==0 ){
	1045	int nByte;
	1046
	1047	if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, pzOut) ){
	1048	Jim_SetResult(interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db)));
	1049	return JIM_ERR;
	1050	}
	1051	if( pStmt==0 ){
	1052	if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
	1053	/* A compile-time error in the statement. */
	1054	Jim_SetResult(interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db)));
	1055	return JIM_ERR;
	1056	}else{
	1057	/* The statement was a no-op. Continue to the next statement
	1058	** in the SQL string.
	1059	*/
	1060	return JIM_OK;
	1061	}
	1062	}
	1063
	1064	assert( pPreStmt==0 );
	1065	nVar = sqlite3_bind_parameter_count(pStmt);
	1066	nByte = sizeof(SqlPreparedStmt) + nVarsizeof(Jim_Obj );
	1067	pPreStmt = (SqlPreparedStmt*)Jim_Alloc(nByte);
	1068	memset(pPreStmt, 0, nByte);
	1069
	1070	pPreStmt->pStmt = pStmt;
	1071	pPreStmt->nSql = (*pzOut - zSql);
	1072	pPreStmt->zSql = sqlite3_sql(pStmt);
	1073	pPreStmt->apParm = (Jim_Obj **)&pPreStmt[1];
	1074	}
	1075	assert( pPreStmt );
	1076	assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql );
	1077	assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) );
	1078
	1079	/* Bind values to parameters that begin with $ or : */
	1080	for(i=1; i<=nVar; i++){
	1081	const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
	1082	if( zVar!=0 && (zVar[0]=='$' \|\| zVar[0]==':' \|\| zVar[0]=='@') ){
	1083	Jim_Obj *pVar = Jim_GetVariableStr(interp, &zVar[1], 0);
	1084	if( pVar ){
	1085	int n;
	1086	u8 *data;
	1087	const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
	1088	char c = zType[0];
	1089	/* XXX: Jim Tcl doesn't have bytearray or boolean */
	1090	if( zVar[0]=='@') {
	1091	#if 0
	1092	\|\|
	1093	(c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
	1094	/* Load a BLOB type if the Tcl variable is a bytearray and
	1095	** it has no string representation or the host
	1096	** parameter name begins with "@". */
	1097	data = Jim_GetByteArrayFromObj(pVar, &n);
	1098	#else
	1099	data = (unsigned char *)Jim_GetString(pVar, &n);
	1100	#endif
	1101	sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
	1102	Jim_IncrRefCount(pVar);
	1103	pPreStmt->apParm[iParm++] = pVar;
	1104	#if 0
	1105	}else if( c=='b' && strcmp(zType,"boolean")==0 ){
	1106	Jim_GetWide(interp, pVar, &n);
	1107	sqlite3_bind_int(pStmt, i, n);
	1108	#endif
	1109	}else if( c=='d' && strcmp(zType,"double")==0 ){
	1110	double r;
	1111	Jim_GetDouble(interp, pVar, &r);
	1112	sqlite3_bind_double(pStmt, i, r);
	1113	}else if( (c=='c' && strcmp(zType,"coerced-double")==0) \|\|
	1114	(c=='i' && strcmp(zType,"int")==0) ){
	1115	jim_wide v;
	1116	Jim_GetWide(interp, pVar, &v);
	1117	sqlite3_bind_int64(pStmt, i, v);
	1118	}else{
	1119	data = (unsigned char *)Jim_GetString(pVar, &n);
	1120	sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
	1121	Jim_IncrRefCount(pVar);
	1122	pPreStmt->apParm[iParm++] = pVar;
	1123	}
	1124	}else{
	1125	sqlite3_bind_null(pStmt, i);
	1126	}
	1127	}
	1128	}
	1129	pPreStmt->nParm = iParm;
	1130	*ppPreStmt = pPreStmt;
	1131
	1132	return JIM_OK;
	1133	}
	1134
	1135
	1136	/*
	1137	** Release a statement reference obtained by calling dbPrepareAndBind().
	1138	** There should be exactly one call to this function for each call to
	1139	** dbPrepareAndBind().
	1140	**
	1141	** If the discard parameter is non-zero, then the statement is deleted
	1142	** immediately. Otherwise it is added to the LRU list and may be returned
	1143	** by a subsequent call to dbPrepareAndBind().
	1144	*/
	1145	static void dbReleaseStmt(
	1146	SqliteDb pDb, / Database handle */
	1147	SqlPreparedStmt pPreStmt, / Prepared statement handle to release */
	1148	int discard /* True to delete (not cache) the pPreStmt */
	1149	){
	1150	int i;
	1151
	1152	/* Free the bound string and blob parameters */
	1153	for(i=0; i<pPreStmt->nParm; i++){
	1154	Jim_DecrRefCount(pDb->interp, pPreStmt->apParm[i]);
	1155	}
	1156	pPreStmt->nParm = 0;
	1157
	1158	if( pDb->maxStmt<=0 \|\| discard ){
	1159	/* If the cache is turned off, deallocated the statement */
	1160	sqlite3_finalize(pPreStmt->pStmt);
	1161	Jim_Free((char *)pPreStmt);
	1162	}else{
	1163	/* Add the prepared statement to the beginning of the cache list. */
	1164	pPreStmt->pNext = pDb->stmtList;
	1165	pPreStmt->pPrev = 0;
	1166	if( pDb->stmtList ){
	1167	pDb->stmtList->pPrev = pPreStmt;
	1168	}
	1169	pDb->stmtList = pPreStmt;
	1170	if( pDb->stmtLast==0 ){
	1171	assert( pDb->nStmt==0 );
	1172	pDb->stmtLast = pPreStmt;
	1173	}else{
	1174	assert( pDb->nStmt>0 );
	1175	}
	1176	pDb->nStmt++;
	1177
	1178	/* If we have too many statement in cache, remove the surplus from
	1179	** the end of the cache list. */
	1180	while( pDb->nStmt>pDb->maxStmt ){
	1181	sqlite3_finalize(pDb->stmtLast->pStmt);
	1182	pDb->stmtLast = pDb->stmtLast->pPrev;
	1183	Jim_Free((char*)pDb->stmtLast->pNext);
	1184	pDb->stmtLast->pNext = 0;
	1185	pDb->nStmt--;
	1186	}
	1187	}
	1188	}
	1189
	1190	/*
	1191	** Structure used with dbEvalXXX() functions:
	1192	**
	1193	** dbEvalInit()
	1194	** dbEvalStep()
	1195	** dbEvalFinalize()
	1196	** dbEvalRowInfo()
	1197	** dbEvalColumnValue()
	1198	*/
	1199	typedef struct DbEvalContext DbEvalContext;
	1200	struct DbEvalContext {
	1201	SqliteDb pDb; / Database handle */
	1202	Jim_Obj pSql; / Object holding string zSql */
	1203	const char zSql; / Remaining SQL to execute */
	1204	SqlPreparedStmt pPreStmt; / Current statement */
	1205	int nCol; /* Number of columns returned by pStmt */
	1206	Jim_Obj pArray; / Name of array variable */
	1207	Jim_Obj *apColName; / Array of column names */
	1208	};
	1209
	1210	/*
	1211	** Release any cache of column names currently held as part of
	1212	** the DbEvalContext structure passed as the first argument.
	1213	*/
	1214	static void dbReleaseColumnNames(DbEvalContext *p){
	1215	if( p->apColName ){
	1216	int i;
	1217	for(i=0; i<p->nCol; i++){
	1218	Jim_DecrRefCount(p->pDb->interp, p->apColName[i]);
	1219	}
	1220	Jim_Free((char *)p->apColName);
	1221	p->apColName = 0;
	1222	}
	1223	p->nCol = 0;
	1224	}
	1225
	1226	/*
	1227	** Initialize a DbEvalContext structure.
	1228	**
	1229	** If pArray is not NULL, then it contains the name of a Tcl array
	1230	** variable. The "*" member of this array is set to a list containing
	1231	** the names of the columns returned by the statement as part of each
	1232	** call to dbEvalStep(), in order from left to right. e.g. if the names
	1233	** of the returned columns are a, b and c, it does the equivalent of the
	1234	** tcl command:
	1235	**
	1236	** set ${pArray}(*) {a b c}
	1237	*/
	1238	static void dbEvalInit(
	1239	DbEvalContext p, / Pointer to structure to initialize */
	1240	SqliteDb pDb, / Database handle */
	1241	Jim_Obj pSql, / Object containing SQL script */
	1242	Jim_Obj pArray / Name of Tcl array to set () element of /
	1243	){
	1244	memset(p, 0, sizeof(DbEvalContext));
	1245	p->pDb = pDb;
	1246	p->zSql = Jim_String(pSql);
	1247	p->pSql = pSql;
	1248	Jim_IncrRefCount(pSql);
	1249	if( pArray ){
	1250	p->pArray = pArray;
	1251	Jim_IncrRefCount(pArray);
	1252	}
	1253	}
	1254
	1255	/*
	1256	** Obtain information about the row that the DbEvalContext passed as the
	1257	** first argument currently points to.
	1258	*/
	1259	static void dbEvalRowInfo(
	1260	DbEvalContext p, / Evaluation context */
	1261	int pnCol, / OUT: Number of column names */
	1262	Jim_Obj **papColName / OUT: Array of column names */
	1263	){
	1264	/* Compute column names */
	1265	if( 0==p->apColName ){
	1266	sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
	1267	int i; /* Iterator variable */
	1268	int nCol; /* Number of columns returned by pStmt */
	1269	Jim_Obj *apColName = 0; / Array of column names */
	1270
	1271	p->nCol = nCol = sqlite3_column_count(pStmt);
	1272	if( nCol>0 && (papColName \|\| p->pArray) ){
	1273	apColName = (Jim_Obj*)Jim_Alloc( sizeof(Jim_Obj)*nCol );
	1274	for(i=0; i<nCol; i++){
	1275	apColName[i] = dbTextToObj(p->pDb->interp, sqlite3_column_name(pStmt,i));
	1276	Jim_IncrRefCount(apColName[i]);
	1277	}
	1278	p->apColName = apColName;
	1279	}
	1280
	1281	/* If results are being stored in an array variable, then create
	1282	** the array(*) entry for that array
	1283	*/
	1284	if( p->pArray ){
	1285	Jim_Interp *interp = p->pDb->interp;
	1286	Jim_Obj *pColList = Jim_NewListObj(interp, apColName, nCol);
	1287	Jim_Obj pStar = Jim_NewStringObj(interp, "", -1);
	1288	Jim_IncrRefCount(pStar);
	1289	Jim_SetDictKeysVector(interp, p->pArray, &pStar, 1, pColList, 0);
	1290	Jim_DecrRefCount(interp, pStar);
	1291	}
	1292	}
	1293
	1294	if( papColName ){
	1295	*papColName = p->apColName;
	1296	}
	1297	if( pnCol ){
	1298	*pnCol = p->nCol;
	1299	}
	1300	}
	1301
	1302	/*
	1303	** Return one of JIM_OK, JIM_BREAK or JIM_ERR. If JIM_ERR is
	1304	** returned, then an error message is stored in the interpreter before
	1305	** returning.
	1306	**
	1307	** A return value of JIM_OK means there is a row of data available. The
	1308	** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This
	1309	** is analogous to a return of SQLITE_ROW from sqlite3_step(). If JIM_BREAK
	1310	** is returned, then the SQL script has finished executing and there are
	1311	** no further rows available. This is similar to SQLITE_DONE.
	1312	*/
	1313	static int dbEvalStep(DbEvalContext *p){
	1314	while( p->zSql[0] \|\| p->pPreStmt ){
	1315	int rc;
	1316	if( p->pPreStmt==0 ){
	1317	rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt);
	1318	if( rc!=JIM_OK ) return rc;
	1319	}else{
	1320	int rcs;
	1321	SqliteDb *pDb = p->pDb;
	1322	SqlPreparedStmt *pPreStmt = p->pPreStmt;
	1323	sqlite3_stmt *pStmt = pPreStmt->pStmt;
	1324
	1325	rcs = sqlite3_step(pStmt);
	1326	if( rcs==SQLITE_ROW ){
	1327	return JIM_OK;
	1328	}
	1329	if( p->pArray ){
	1330	dbEvalRowInfo(p, 0, 0);
	1331	}
	1332	rcs = sqlite3_reset(pStmt);
	1333
	1334	pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
	1335	pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
	1336	dbReleaseColumnNames(p);
	1337	p->pPreStmt = 0;
	1338
	1339	if( rcs!=SQLITE_OK ){
	1340	/* If a run-time error occurs, report the error and stop reading
	1341	** the SQL. */
	1342	Jim_SetResult(pDb->interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db)));
	1343	dbReleaseStmt(pDb, pPreStmt, 1);
	1344	return JIM_ERR;
	1345	}else{
	1346	dbReleaseStmt(pDb, pPreStmt, 0);
	1347	}
	1348	}
	1349	}
	1350
	1351	/* Finished */
	1352	return JIM_BREAK;
	1353	}
	1354
	1355	/*
	1356	** Free all resources currently held by the DbEvalContext structure passed
	1357	** as the first argument. There should be exactly one call to this function
	1358	** for each call to dbEvalInit().
	1359	*/
	1360	static void dbEvalFinalize(DbEvalContext *p){
	1361	if( p->pPreStmt ){
	1362	sqlite3_reset(p->pPreStmt->pStmt);
	1363	dbReleaseStmt(p->pDb, p->pPreStmt, 0);
	1364	p->pPreStmt = 0;
	1365	}
	1366	if( p->pArray ){
	1367	Jim_DecrRefCount(p->pDb->interp, p->pArray);
	1368	p->pArray = 0;
	1369	}
	1370	Jim_DecrRefCount(p->pDb->interp, p->pSql);
	1371	dbReleaseColumnNames(p);
	1372	}
	1373
	1374	/*
	1375	** Return a pointer to a Jim_Obj structure with ref-count 0 that contains
	1376	** the value for the iCol'th column of the row currently pointed to by
	1377	** the DbEvalContext structure passed as the first argument.
	1378	*/
	1379	static Jim_Obj dbEvalColumnValue(DbEvalContext p, int iCol){
	1380	sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
	1381	switch( sqlite3_column_type(pStmt, iCol) ){
	1382	case SQLITE_BLOB: {
	1383	int bytes = sqlite3_column_bytes(pStmt, iCol);
	1384	const char *zBlob = sqlite3_column_blob(pStmt, iCol);
	1385	if( !zBlob ) bytes = 0;
	1386	//return Jim_NewByteArrayObj((u8*)zBlob, bytes);
	1387	return Jim_NewStringObj(p->pDb->interp, zBlob, bytes);
	1388	}
	1389	case SQLITE_INTEGER: {
	1390	sqlite_int64 v = sqlite3_column_int64(pStmt, iCol);
	1391	return Jim_NewIntObj(p->pDb->interp, v);
	1392	}
	1393	case SQLITE_FLOAT: {
	1394	return Jim_NewDoubleObj(p->pDb->interp, sqlite3_column_double(pStmt, iCol));
	1395	}
	1396	case SQLITE_NULL: {
	1397	return dbTextToObj(p->pDb->interp, p->pDb->zNull);
	1398	}
	1399	}
	1400
	1401	return dbTextToObj(p->pDb->interp, (char *)sqlite3_column_text(pStmt, iCol));
	1402	}
	1403
	1404	static int Jim_ObjSetVar2(Jim_Interp interp, Jim_Obj nameObjPtr, Jim_Obj keyObjPtr, Jim_Obj valObjPtr)
	1405	{
	1406	return Jim_SetDictKeysVector(interp, nameObjPtr, &keyObjPtr, 1, valObjPtr, 0);
	1407	}
	1408
	1409	/*
	1410	** This function is part of the implementation of the command:
	1411	**
	1412	** $db eval SQL ?ARRAYNAME? SCRIPT
	1413	*/
	1414	static int DbEvalNextCmd(
	1415	Jim_Interp interp, / Tcl interpreter */
	1416	DbEvalContext *p,
	1417	Jim_Obj *pScript,
	1418	int result /* Result so far */
	1419	){
	1420	int rc = result; /* Return code */
	1421
	1422	Jim_Obj *pArray = p->pArray;
	1423
	1424	while( (rc==JIM_OK \|\| rc==JIM_CONTINUE) && JIM_OK==(rc = dbEvalStep(p)) ){
	1425	int i;
	1426	int nCol;
	1427	Jim_Obj **apColName;
	1428	dbEvalRowInfo(p, &nCol, &apColName);
	1429	for(i=0; i<nCol; i++){
	1430	Jim_Obj *pVal = dbEvalColumnValue(p, i);
	1431	if( pArray==0 ){
	1432	Jim_SetVariable(interp, apColName[i], pVal);
	1433	}else{
	1434	Jim_ObjSetVar2(interp, pArray, apColName[i], pVal);
	1435	}
	1436	}
	1437
	1438	/* The required interpreter variables are now populated with the data
	1439	** from the current row.
	1440	**
	1441	** No NRE in Jim Tcl, so evaluate pScript directly and continue with the
	1442	** next iteration of this while(...) loop. */
	1443	rc = Jim_EvalObj(interp, pScript);
	1444	}
	1445
	1446	Jim_DecrRefCount(interp, pScript);
	1447	dbEvalFinalize(p);
	1448	Jim_Free((char *)p);
	1449
	1450	if( rc==JIM_OK \|\| rc==JIM_BREAK ){
	1451	Jim_SetEmptyResult(interp);
	1452	rc = JIM_OK;
	1453	}
	1454	return rc;
	1455	}
	1456
	1457	/*
	1458	** The "sqlite" command below creates a new Tcl command for each
	1459	** connection it opens to an SQLite database. This routine is invoked
	1460	** whenever one of those connection-specific commands is executed
	1461	** in Tcl. For example, if you run Tcl code like this:
	1462	**
	1463	** sqlite3 db1 "my_database"
	1464	** db1 close
	1465	**
	1466	** The first command opens a connection to the "my_database" database
	1467	** and calls that connection "db1". The second command causes this
	1468	** subroutine to be invoked.
	1469	*/
	1470	static int DbObjCmd(Jim_Interp interp, int objc,Jim_Obj const*objv){
	1471	SqliteDb pDb = (SqliteDb)Jim_CmdPrivData(interp);
	1472	int choice;
	1473	int rc = JIM_OK;
	1474	static const char *DB_strs[] = {
	1475	"authorizer", "backup", "busy",
	1476	"cache", "changes", "close",
	1477	"collate", "collation_needed", "commit_hook",
	1478	"complete", "copy", "enable_load_extension",
	1479	"errorcode", "eval", "exists",
	1480	"function", "incrblob", "interrupt",
	1481	"last_insert_rowid", "nullvalue", "onecolumn",
	1482	"profile", "progress", "rekey",
	1483	"restore", "rollback_hook", "status",
	1484	"timeout", "total_changes", "trace",
	1485	"transaction", "unlock_notify", "update_hook",
	1486	"version", 0
	1487	};
	1488	enum DB_enum {
	1489	DB_AUTHORIZER, DB_BACKUP, DB_BUSY,
	1490	DB_CACHE, DB_CHANGES, DB_CLOSE,
	1491	DB_COLLATE, DB_COLLATION_NEEDED, DB_COMMIT_HOOK,
	1492	DB_COMPLETE, DB_COPY, DB_ENABLE_LOAD_EXTENSION,
	1493	DB_ERRORCODE, DB_EVAL, DB_EXISTS,
	1494	DB_FUNCTION, DB_INCRBLOB, DB_INTERRUPT,
	1495	DB_LAST_INSERT_ROWID, DB_NULLVALUE, DB_ONECOLUMN,
	1496	DB_PROFILE, DB_PROGRESS, DB_REKEY,
	1497	DB_RESTORE, DB_ROLLBACK_HOOK, DB_STATUS,
	1498	DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE,
	1499	DB_TRANSACTION, DB_UNLOCK_NOTIFY, DB_UPDATE_HOOK,
	1500	DB_VERSION,
	1501	};
	1502	/* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
	1503
	1504	if( objc<2 ){
	1505	Jim_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
	1506	return JIM_ERR;
	1507	}
	1508	if( Jim_GetEnum(interp, objv[1], DB_strs, &choice, "option", JIM_ERRMSG \| JIM_ENUM_ABBREV) ){
	1509	return JIM_ERR;
	1510	}
	1511
	1512	switch( (enum DB_enum)choice ){
	1513
	1514	/* $db authorizer ?CALLBACK?
	1515	**
	1516	** Invoke the given callback to authorize each SQL operation as it is
	1517	** compiled. 5 arguments are appended to the callback before it is
	1518	** invoked:
	1519	**
	1520	** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
	1521	** (2) First descriptive name (depends on authorization type)
	1522	** (3) Second descriptive name
	1523	** (4) Name of the database (ex: "main", "temp")
	1524	** (5) Name of trigger that is doing the access
	1525	**
	1526	** The callback should return on of the following strings: SQLITE_OK,
	1527	** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
	1528	**
	1529	** If this method is invoked with no arguments, the current authorization
	1530	** callback string is returned.
	1531	*/
	1532	case DB_AUTHORIZER: {
	1533	#ifdef SQLITE_OMIT_AUTHORIZATION
	1534	Jim_SetResultString(interp, "authorization not available in this build", -1);
	1535	return JIM_ERR;
	1536	#else
	1537	if( objc>3 ){
	1538	Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
	1539	return JIM_ERR;
	1540	}else if( objc==2 ){
	1541	if( pDb->zAuth ){
	1542	Jim_SetResultString(interp, pDb->zAuth, -1);
	1543	}
	1544	}else{
	1545	const char *zAuth;
	1546	int len;
	1547	if( pDb->zAuth ){
	1548	Jim_Free(pDb->zAuth);
	1549	}
	1550	zAuth = Jim_GetString(objv[2], &len);
	1551	if( zAuth && len>0 ){
	1552	pDb->zAuth = Jim_Alloc( len + 1 );
	1553	memcpy(pDb->zAuth, zAuth, len+1);
	1554	}else{
	1555	pDb->zAuth = 0;
	1556	}
	1557	if( pDb->zAuth ){
	1558	pDb->interp = interp;
	1559	sqlite3_set_authorizer(pDb->db, auth_callback, pDb);
	1560	}else{
	1561	sqlite3_set_authorizer(pDb->db, 0, 0);
	1562	}
	1563	}
	1564	#endif
	1565	break;
	1566	}
	1567
	1568	/* $db backup ?DATABASE? FILENAME
	1569	**
	1570	** Open or create a database file named FILENAME. Transfer the
	1571	** content of local database DATABASE (default: "main") into the
	1572	** FILENAME database.
	1573	*/
	1574	case DB_BACKUP: {
	1575	const char *zDestFile;
	1576	const char *zSrcDb;
	1577	sqlite3 *pDest;
	1578	sqlite3_backup *pBackup;
	1579
	1580	if( objc==3 ){
	1581	zSrcDb = "main";
	1582	zDestFile = Jim_String(objv[2]);
	1583	}else if( objc==4 ){
	1584	zSrcDb = Jim_String(objv[2]);
	1585	zDestFile = Jim_String(objv[3]);
	1586	}else{
	1587	Jim_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
	1588	return JIM_ERR;
	1589	}
	1590	rc = sqlite3_open(zDestFile, &pDest);
	1591	if( rc!=SQLITE_OK ){
	1592	Jim_SetResultFormatted(interp, "cannot open target database: %s", sqlite3_errmsg(pDest));
	1593	sqlite3_close(pDest);
	1594	return JIM_ERR;
	1595	}
	1596	pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb);
	1597	if( pBackup==0 ){
	1598	Jim_SetResultFormatted(interp, "backup failed: %s", sqlite3_errmsg(pDest));
	1599	sqlite3_close(pDest);
	1600	return JIM_ERR;
	1601	}
	1602	while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){}
	1603	sqlite3_backup_finish(pBackup);
	1604	if( rc==SQLITE_DONE ){
	1605	rc = JIM_OK;
	1606	}else{
	1607	Jim_SetResultFormatted(interp, "backup failed: %s", sqlite3_errmsg(pDest));
	1608	rc = JIM_ERR;
	1609	}
	1610	sqlite3_close(pDest);
	1611	break;
	1612	}
	1613
	1614	/* $db busy ?CALLBACK?
	1615	**
	1616	** Invoke the given callback if an SQL statement attempts to open
	1617	** a locked database file.
	1618	*/
	1619	case DB_BUSY: {
	1620	if( objc>3 ){
	1621	Jim_WrongNumArgs(interp, 2, objv, "CALLBACK");
	1622	return JIM_ERR;
	1623	}else if( objc==2 ){
	1624	if( pDb->zBusy ){
	1625	Jim_SetResultString(interp, pDb->zBusy, -1);
	1626	}
	1627	}else{
	1628	const char *zBusy;
	1629	int len;
	1630	if( pDb->zBusy ){
	1631	Jim_Free(pDb->zBusy);
	1632	}
	1633	zBusy = Jim_GetString(objv[2], &len);
	1634	if( zBusy && len>0 ){
	1635	pDb->zBusy = Jim_Alloc( len + 1 );
	1636	memcpy(pDb->zBusy, zBusy, len+1);
	1637	}else{
	1638	pDb->zBusy = 0;
	1639	}
	1640	if( pDb->zBusy ){
	1641	pDb->interp = interp;
	1642	sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
	1643	}else{
	1644	sqlite3_busy_handler(pDb->db, 0, 0);
	1645	}
	1646	}
	1647	break;
	1648	}
	1649
	1650	/* $db cache flush
	1651	** $db cache size n
	1652	**
	1653	** Flush the prepared statement cache, or set the maximum number of
	1654	** cached statements.
	1655	*/
	1656	case DB_CACHE: {
	1657	const char *subCmd;
	1658
	1659	if( objc<=2 ){
	1660	Jim_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
	1661	return JIM_ERR;
	1662	}
	1663	subCmd = Jim_String( objv[2]);
	1664	if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
	1665	if( objc!=3 ){
	1666	Jim_WrongNumArgs(interp, 2, objv, "flush");
	1667	return JIM_ERR;
	1668	}else{
	1669	flushStmtCache( pDb );
	1670	}
	1671	}else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
	1672	if( objc!=4 ){
	1673	Jim_WrongNumArgs(interp, 2, objv, "size n");
	1674	return JIM_ERR;
	1675	}else{
	1676	jim_wide w;
	1677	if( JIM_ERR==Jim_GetWide(interp, objv[3], &w) ){
	1678	return JIM_ERR;
	1679	}else{
	1680	if( w<0 ){
	1681	flushStmtCache( pDb );
	1682	w = 0;
	1683	}else if( w>MAX_PREPARED_STMTS ){
	1684	w = MAX_PREPARED_STMTS;
	1685	}
	1686	pDb->maxStmt = w;
	1687	}
	1688	}
	1689	}else{
	1690	Jim_SetResultFormatted(interp, "bad option \"%#s\": must be flush or size", objv[2]);
	1691	return JIM_ERR;
	1692	}
	1693	break;
	1694	}
	1695
	1696	/* $db changes
	1697	**
	1698	** Return the number of rows that were modified, inserted, or deleted by
	1699	** the most recent INSERT, UPDATE or DELETE statement, not including
	1700	** any changes made by trigger programs.
	1701	*/
	1702	case DB_CHANGES: {
	1703	if( objc!=2 ){
	1704	Jim_WrongNumArgs(interp, 2, objv, "");
	1705	return JIM_ERR;
	1706	}
	1707	Jim_SetResultInt(interp, sqlite3_changes(pDb->db));
	1708	break;
	1709	}
	1710
	1711	/* $db close
	1712	**
	1713	** Shutdown the database
	1714	*/
	1715	case DB_CLOSE: {
	1716	Jim_DeleteCommand(interp, objv[0]);
	1717	break;
	1718	}
	1719
	1720	/*
	1721	** $db collate NAME SCRIPT
	1722	**
	1723	** Create a new SQL collation function called NAME. Whenever
	1724	** that function is called, invoke SCRIPT to evaluate the function.
	1725	*/
	1726	case DB_COLLATE: {
	1727	SqlCollate *pCollate;
	1728	const char *zName;
	1729	const char *zScript;
	1730	int nScript;
	1731	if( objc!=4 ){
	1732	Jim_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
	1733	return JIM_ERR;
	1734	}
	1735	zName = Jim_String(objv[2]);
	1736	zScript = Jim_GetString(objv[3], &nScript);
	1737	pCollate = (SqlCollate)Jim_Alloc( sizeof(pCollate) + nScript + 1 );
	1738	if( pCollate==0 ) return JIM_ERR;
	1739	pCollate->interp = interp;
	1740	pCollate->pNext = pDb->pCollate;
	1741	pCollate->zScript = (char*)&pCollate[1];
	1742	pDb->pCollate = pCollate;
	1743	memcpy(pCollate->zScript, zScript, nScript+1);
	1744	if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
	1745	pCollate, tclSqlCollate) ){
	1746	Jim_SetResultString(interp, (char *)sqlite3_errmsg(pDb->db), -1);
	1747	return JIM_ERR;
	1748	}
	1749	break;
	1750	}
	1751
	1752	/*
	1753	** $db collation_needed SCRIPT
	1754	**
	1755	** Create a new SQL collation function called NAME. Whenever
	1756	** that function is called, invoke SCRIPT to evaluate the function.
	1757	*/
	1758	case DB_COLLATION_NEEDED: {
	1759	if( objc!=3 ){
	1760	Jim_WrongNumArgs(interp, 2, objv, "SCRIPT");
	1761	return JIM_ERR;
	1762	}
	1763	if( pDb->pCollateNeeded ){
	1764	Jim_DecrRefCount(interp, pDb->pCollateNeeded);
	1765	}
	1766	pDb->pCollateNeeded = Jim_DuplicateObj(pDb->interp, objv[2]);
	1767	Jim_IncrRefCount(pDb->pCollateNeeded);
	1768	sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
	1769	break;
	1770	}
	1771
	1772	/* $db commit_hook ?CALLBACK?
	1773	**
	1774	** Invoke the given callback just before committing every SQL transaction.
	1775	** If the callback throws an exception or returns non-zero, then the
	1776	** transaction is aborted. If CALLBACK is an empty string, the callback
	1777	** is disabled.
	1778	*/
	1779	case DB_COMMIT_HOOK: {
	1780	if( objc>3 ){
	1781	Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
	1782	return JIM_ERR;
	1783	}else if( objc==2 ){
	1784	if( pDb->zCommit ){
	1785	Jim_SetResultString(interp, pDb->zCommit, -1);
	1786	}
	1787	}else{
	1788	const char *zCommit;
	1789	int len;
	1790	if( pDb->zCommit ){
	1791	Jim_Free(pDb->zCommit);
	1792	}
	1793	zCommit = Jim_GetString(objv[2], &len);
	1794	if( zCommit && len>0 ){
	1795	pDb->zCommit = Jim_Alloc( len + 1 );
	1796	memcpy(pDb->zCommit, zCommit, len+1);
	1797	}else{
	1798	pDb->zCommit = 0;
	1799	}
	1800	if( pDb->zCommit ){
	1801	pDb->interp = interp;
	1802	sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
	1803	}else{
	1804	sqlite3_commit_hook(pDb->db, 0, 0);
	1805	}
	1806	}
	1807	break;
	1808	}
	1809
	1810	/* $db complete SQL
	1811	**
	1812	** Return TRUE if SQL is a complete SQL statement. Return FALSE if
	1813	** additional lines of input are needed. This is similar to the
	1814	** built-in "info complete" command of Tcl.
	1815	*/
	1816	case DB_COMPLETE: {
	1817	#ifndef SQLITE_OMIT_COMPLETE
	1818	if( objc!=3 ){
	1819	Jim_WrongNumArgs(interp, 2, objv, "SQL");
	1820	return JIM_ERR;
	1821	}
	1822	Jim_SetResultInt(interp, sqlite3_complete( Jim_String(objv[2]) ));
	1823	#endif
	1824	break;
	1825	}
	1826
	1827	/* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
	1828	**
	1829	** Copy data into table from filename, optionally using SEPARATOR
	1830	** as column separators. If a column contains a null string, or the
	1831	** value of NULLINDICATOR, a NULL is inserted for the column.
	1832	** conflict-algorithm is one of the sqlite conflict algorithms:
	1833	** rollback, abort, fail, ignore, replace
	1834	** On success, return the number of lines processed, not necessarily same
	1835	** as 'db changes' due to conflict-algorithm selected.
	1836	**
	1837	** This code is basically an implementation/enhancement of
	1838	** the sqlite3 shell.c ".import" command.
	1839	**
	1840	** This command usage is equivalent to the sqlite2.x COPY statement,
	1841	** which imports file data into a table using the PostgreSQL COPY file format:
	1842	** $db copy $conflit_algo $table_name $filename \t \\N
	1843	*/
	1844	case DB_COPY: {
	1845	const char zTable; / Insert data into this table */
	1846	const char zFile; / The file from which to extract data */
	1847	const char zConflict; / The conflict algorithm to use */
	1848	sqlite3_stmt pStmt; / A statement */
	1849	int nCol; /* Number of columns in the table */
	1850	int nByte; /* Number of bytes in an SQL string */
	1851	int i, j; /* Loop counters */
	1852	int nSep; /* Number of bytes in zSep[] */
	1853	int nNull; /* Number of bytes in zNull[] */
	1854	char zSql; / An SQL statement */
	1855	char zLine; / A single line of input from the file */
	1856	char *azCol; / zLine[] broken up into columns */
	1857	char zCommit; / How to commit changes */
	1858	FILE in; / The input file */
	1859	int lineno = 0; /* Line number of input file */
	1860	char zLineNum[80]; /* Line number print buffer */
	1861
	1862	const char *zSep;
	1863	const char *zNull;
	1864	if( objc<5 \|\| objc>7 ){
	1865	Jim_WrongNumArgs(interp, 2, objv,
	1866	"CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
	1867	return JIM_ERR;
	1868	}
	1869	if( objc>=6 ){
	1870	zSep = Jim_String(objv[5]);
	1871	}else{
	1872	zSep = "\t";
	1873	}
	1874	if( objc>=7 ){
	1875	zNull = Jim_String(objv[6]);
	1876	}else{
	1877	zNull = "";
	1878	}
	1879	zConflict = Jim_String(objv[2]);
	1880	zTable = Jim_String(objv[3]);
	1881	zFile = Jim_String(objv[4]);
	1882	nSep = strlen30(zSep);
	1883	nNull = strlen30(zNull);
	1884	if( nSep==0 ){
	1885	Jim_SetResultString(interp, "Error: non-null separator required for copy", -1);
	1886	return JIM_ERR;
	1887	}
	1888	if(strcmp(zConflict, "rollback") != 0 &&
	1889	strcmp(zConflict, "abort" ) != 0 &&
	1890	strcmp(zConflict, "fail" ) != 0 &&
	1891	strcmp(zConflict, "ignore" ) != 0 &&
	1892	strcmp(zConflict, "replace" ) != 0 ) {
	1893	Jim_SetResultFormatted(interp, "Error: \"%s\", conflict-algorithm must be one of: rollback, "
	1894	"abort, fail, ignore, or replace", zConflict);
	1895	return JIM_ERR;
	1896	}
	1897	zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
	1898	if( zSql==0 ){
	1899	Jim_SetResultFormatted(interp, "Error: no such table: %s", zTable);
	1900	return JIM_ERR;
	1901	}
	1902	nByte = strlen30(zSql);
	1903	rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
	1904	sqlite3_free(zSql);
	1905	if( rc ){
	1906	Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db));
	1907	nCol = 0;
	1908	}else{
	1909	nCol = sqlite3_column_count(pStmt);
	1910	}
	1911	sqlite3_finalize(pStmt);
	1912	if( nCol==0 ) {
	1913	return JIM_ERR;
	1914	}
	1915	zSql = Jim_Alloc( nByte + 50 + nCol*2 );
	1916	sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
	1917	zConflict, zTable);
	1918	j = strlen30(zSql);
	1919	for(i=1; i<nCol; i++){
	1920	zSql[j++] = ',';
	1921	zSql[j++] = '?';
	1922	}
	1923	zSql[j++] = ')';
	1924	zSql[j] = 0;
	1925	rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
	1926	Jim_Free(zSql);
	1927	if( rc ){
	1928	Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db));
	1929	sqlite3_finalize(pStmt);
	1930	return JIM_ERR;
	1931	}
	1932	in = fopen(zFile, "rb");
	1933	if( in==0 ){
	1934	Jim_SetResultFormatted(interp, "Error: cannot open file: %s", zFile);
	1935	sqlite3_finalize(pStmt);
	1936	return JIM_ERR;
	1937	}
	1938	azCol = Jim_Alloc( sizeof(azCol[0])*(nCol+1) );
	1939	(void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
	1940	zCommit = "COMMIT";
	1941	while( (zLine = local_getline(0, in))!=0 ){
	1942	char *z;
	1943	i = 0;
	1944	lineno++;
	1945	azCol[0] = zLine;
	1946	for(i=0, z=zLine; *z; z++){
	1947	if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
	1948	*z = 0;
	1949	i++;
	1950	if( i<nCol ){
	1951	azCol[i] = &z[nSep];
	1952	z += nSep-1;
	1953	}
	1954	}
	1955	}
	1956	if( i+1!=nCol ){
	1957	char *zErr;
	1958	int nErr = strlen30(zFile) + 200;
	1959	zErr = Jim_Alloc(nErr);
	1960	sqlite3_snprintf(nErr, zErr,
	1961	"Error: %s line %d: expected %d columns of data but found %d",
	1962	zFile, lineno, nCol, i+1);
	1963	Jim_SetResultString(interp, zErr, -1);
	1964	Jim_Free(zErr);
	1965	zCommit = "ROLLBACK";
	1966	break;
	1967	}
	1968	for(i=0; i<nCol; i++){
	1969	/* check for null data, if so, bind as null */
	1970	if( (nNull>0 && strcmp(azCol[i], zNull)==0)
	1971	\|\| strlen30(azCol[i])==0
	1972	){
	1973	sqlite3_bind_null(pStmt, i+1);
	1974	}else{
	1975	sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
	1976	}
	1977	}
	1978	sqlite3_step(pStmt);
	1979	rc = sqlite3_reset(pStmt);
	1980	Jim_Free(zLine);
	1981	if( rc!=SQLITE_OK ){
	1982	Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db));
	1983	zCommit = "ROLLBACK";
	1984	break;
	1985	}
	1986	}
	1987	Jim_Free(azCol);
	1988	fclose(in);
	1989	sqlite3_finalize(pStmt);
	1990	(void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
	1991
	1992	if( zCommit[0] == 'C' ){
	1993	/* success, set result as number of lines processed */
	1994	Jim_SetResultInt(interp, lineno);
	1995	rc = JIM_OK;
	1996	}else{
	1997	/* failure, append lineno where failed */
	1998	sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
	1999	Jim_AppendStrings(interp, Jim_GetResult(interp), ", failed while processing line: ", zLineNum, NULL);
	2000	rc = JIM_ERR;
	2001	}
	2002	break;
	2003	}
	2004
	2005	/*
	2006	** $db enable_load_extension BOOLEAN
	2007	**
	2008	** Turn the extension loading feature on or off. It if off by
	2009	** default.
	2010	*/
	2011	case DB_ENABLE_LOAD_EXTENSION: {
	2012	#ifndef SQLITE_OMIT_LOAD_EXTENSION
	2013	long onoff;
	2014	if( objc!=3 ){
	2015	Jim_WrongNumArgs(interp, 2, objv, "BOOLEAN");
	2016	return JIM_ERR;
	2017	}
	2018	if( Jim_GetLong(interp, objv[2], &onoff) ){
	2019	return JIM_ERR;
	2020	}
	2021	sqlite3_enable_load_extension(pDb->db, onoff);
	2022	break;
	2023	#else
	2024	Jim_SetResultString(interp, "extension loading is turned off at compile-time", -1);
	2025	return JIM_ERR;
	2026	#endif
	2027	}
	2028
	2029	/*
	2030	** $db errorcode
	2031	**
	2032	** Return the numeric error code that was returned by the most recent
	2033	** call to sqlite3_exec().
	2034	*/
	2035	case DB_ERRORCODE: {
	2036	Jim_SetResultInt(interp, sqlite3_errcode(pDb->db));
	2037	break;
	2038	}
	2039
	2040	/*
	2041	** $db exists $sql
	2042	** $db onecolumn $sql
	2043	**
	2044	** The onecolumn method is the equivalent of:
	2045	** lindex [$db eval $sql] 0
	2046	*/
	2047	case DB_EXISTS:
	2048	case DB_ONECOLUMN: {
	2049	DbEvalContext sEval;
	2050	if( objc!=3 ){
	2051	Jim_WrongNumArgs(interp, 2, objv, "SQL");
	2052	return JIM_ERR;
	2053	}
	2054
	2055	dbEvalInit(&sEval, pDb, objv[2], 0);
	2056	rc = dbEvalStep(&sEval);
	2057	if( choice==DB_ONECOLUMN ){
	2058	if( rc==JIM_OK ){
	2059	Jim_SetResult(interp, dbEvalColumnValue(&sEval, 0));
	2060	}
	2061	}else if( rc==JIM_BREAK \|\| rc==JIM_OK ){
	2062	Jim_SetResultInt(interp, rc==JIM_OK);
	2063	}
	2064	dbEvalFinalize(&sEval);
	2065
	2066	if( rc==JIM_BREAK ){
	2067	rc = JIM_OK;
	2068	}
	2069	break;
	2070	}
	2071
	2072	/*
	2073	** $db eval $sql ?array? ?{ ...code... }?
	2074	**
	2075	** The SQL statement in $sql is evaluated. For each row, the values are
	2076	** placed in elements of the array named "array" and ...code... is executed.
	2077	** If "array" and "code" are omitted, then no callback is every invoked.
	2078	** If "array" is an empty string, then the values are placed in variables
	2079	** that have the same name as the fields extracted by the query.
	2080	*/
	2081	case DB_EVAL: {
	2082	if( objc<3 \|\| objc>5 ){
	2083	Jim_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
	2084	return JIM_ERR;
	2085	}
	2086
	2087	if( objc==3 ){
	2088	DbEvalContext sEval;
	2089	Jim_Obj *pRet = Jim_NewListObj(interp, NULL, 0);
	2090	Jim_IncrRefCount(pRet);
	2091	dbEvalInit(&sEval, pDb, objv[2], 0);
	2092	while( JIM_OK==(rc = dbEvalStep(&sEval)) ){
	2093	int i;
	2094	int nCol;
	2095	dbEvalRowInfo(&sEval, &nCol, 0);
	2096	for(i=0; i<nCol; i++){
	2097	Jim_ListAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i));
	2098	}
	2099	}
	2100	dbEvalFinalize(&sEval);
	2101	if( rc==JIM_BREAK ){
	2102	Jim_SetResult(interp, pRet);
	2103	rc = JIM_OK;
	2104	}
	2105	Jim_DecrRefCount(interp, pRet);
	2106	}else{
	2107	DbEvalContext *p;
	2108	Jim_Obj *pArray = 0;
	2109	Jim_Obj *pScript;
	2110
	2111	if( objc==5 && Jim_Length(objv[3]) ){
	2112	pArray = objv[3];
	2113	}
	2114	pScript = objv[objc-1];
	2115	Jim_IncrRefCount(pScript);
	2116
	2117	p = (DbEvalContext *)Jim_Alloc(sizeof(DbEvalContext));
	2118	dbEvalInit(p, pDb, objv[2], pArray);
	2119
	2120	rc = DbEvalNextCmd(interp, p, pScript, JIM_OK);
	2121	}
	2122	break;
	2123	}
	2124
	2125	/*
	2126	** $db function NAME [-argcount N] SCRIPT
	2127	**
	2128	** Create a new SQL function called NAME. Whenever that function is
	2129	** called, invoke SCRIPT to evaluate the function.
	2130	*/
	2131	case DB_FUNCTION: {
	2132	SqlFunc *pFunc;
	2133	Jim_Obj *pScript;
	2134	const char *zName;
	2135	long nArg = -1;
	2136	if( objc==6 ){
	2137	const char *z = Jim_String(objv[3]);
	2138	int n = strlen30(z);
	2139	if( n>2 && strncmp(z, "-argcount",n)==0 ){
	2140	if( Jim_GetLong(interp, objv[4], &nArg) ) return JIM_ERR;
	2141	if( nArg<0 ){
	2142	Jim_SetResultString(interp, "number of arguments must be non-negative", -1);
	2143	return JIM_ERR;
	2144	}
	2145	}
	2146	pScript = objv[5];
	2147	}else if( objc!=4 ){
	2148	Jim_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT");
	2149	return JIM_ERR;
	2150	}else{
	2151	pScript = objv[3];
	2152	}
	2153	zName = Jim_String(objv[2]);
	2154	pFunc = findSqlFunc(pDb, zName);
	2155	if( pFunc==0 ) return JIM_ERR;
	2156	if( pFunc->pScript ){
	2157	Jim_DecrRefCount(interp, pFunc->pScript);
	2158	}
	2159	pFunc->pScript = pScript;
	2160	Jim_IncrRefCount(pScript);
	2161	pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
	2162	rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8,
	2163	pFunc, tclSqlFunc, 0, 0);
	2164	if( rc!=SQLITE_OK ){
	2165	rc = JIM_ERR;
	2166	Jim_SetResultString(interp, (char *)sqlite3_errmsg(pDb->db), -1);
	2167	}
	2168	break;
	2169	}
	2170
	2171	/*
	2172	** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
	2173	*/
	2174	case DB_INCRBLOB: {
	2175	#ifdef SQLITE_OMIT_INCRBLOB
	2176	Jim_SetResultString(interp, "incrblob not available in this build", -1);
	2177	return JIM_ERR;
	2178	#else
	2179	int isReadonly = 0;
	2180	const char *zDb = "main";
	2181	const char *zTable;
	2182	const char *zColumn;
	2183	sqlite_int64 iRow;
	2184
	2185	/* Check for the -readonly option */
	2186	if( objc>3 && strcmp(Jim_GetString(objv[2]), "-readonly")==0 ){
	2187	isReadonly = 1;
	2188	}
	2189
	2190	if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
	2191	Jim_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
	2192	return JIM_ERR;
	2193	}
	2194
	2195	if( objc==(6+isReadonly) ){
	2196	zDb = Jim_GetString(objv[2]);
	2197	}
	2198	zTable = Jim_GetString(objv[objc-3]);
	2199	zColumn = Jim_GetString(objv[objc-2]);
	2200	rc = Jim_GetWide(interp, objv[objc-1], &iRow);
	2201
	2202	if( rc==JIM_OK ){
	2203	rc = createIncrblobChannel(
	2204	interp, pDb, zDb, zTable, zColumn, iRow, isReadonly
	2205	);
	2206	}
	2207	#endif
	2208	break;
	2209	}
	2210
	2211	/*
	2212	** $db interrupt
	2213	**
	2214	** Interrupt the execution of the inner-most SQL interpreter. This
	2215	** causes the SQL statement to return an error of SQLITE_INTERRUPT.
	2216	*/
	2217	case DB_INTERRUPT: {
	2218	sqlite3_interrupt(pDb->db);
	2219	break;
	2220	}
	2221
	2222	/*
	2223	** $db nullvalue ?STRING?
	2224	**
	2225	** Change text used when a NULL comes back from the database. If ?STRING?
	2226	** is not present, then the current string used for NULL is returned.
	2227	** If STRING is present, then STRING is returned.
	2228	**
	2229	*/
	2230	case DB_NULLVALUE: {
	2231	if( objc!=2 && objc!=3 ){
	2232	Jim_WrongNumArgs(interp, 2, objv, "NULLVALUE");
	2233	return JIM_ERR;
	2234	}
	2235	if( objc==3 ){
	2236	int len;
	2237	const char *zNull = Jim_GetString(objv[2], &len);
	2238	if( pDb->zNull ){
	2239	Jim_Free(pDb->zNull);
	2240	}
	2241	if( zNull && len>0 ){
	2242	pDb->zNull = Jim_Alloc( len + 1 );
	2243	strncpy(pDb->zNull, zNull, len);
	2244	pDb->zNull[len] = '\0';
	2245	}else{
	2246	pDb->zNull = 0;
	2247	}
	2248	}
	2249	Jim_SetResult(interp, dbTextToObj(interp, pDb->zNull));
	2250	break;
	2251	}
	2252
	2253	/*
	2254	** $db last_insert_rowid
	2255	**
	2256	** Return an integer which is the ROWID for the most recent insert.
	2257	*/
	2258	case DB_LAST_INSERT_ROWID: {
	2259	if( objc!=2 ){
	2260	Jim_WrongNumArgs(interp, 2, objv, "");
	2261	return JIM_ERR;
	2262	}
	2263	Jim_SetResultInt(interp, sqlite3_last_insert_rowid(pDb->db));
	2264	break;
	2265	}
	2266
	2267	/*
	2268	** The DB_ONECOLUMN method is implemented together with DB_EXISTS.
	2269	*/
	2270
	2271	/* $db progress ?N CALLBACK?
	2272	**
	2273	** Invoke the given callback every N virtual machine opcodes while executing
	2274	** queries.
	2275	*/
	2276	case DB_PROGRESS: {
	2277	if( objc==2 ){
	2278	if( pDb->zProgress ){
	2279	Jim_AppendString(interp, Jim_GetResult(interp), pDb->zProgress, -1);
	2280	}
	2281	}else if( objc==4 ){
	2282	const char *zProgress;
	2283	int len;
	2284	long N;
	2285	if( JIM_OK!=Jim_GetLong(interp, objv[2], &N) ){
	2286	return JIM_ERR;
	2287	};
	2288	if( pDb->zProgress ){
	2289	Jim_Free(pDb->zProgress);
	2290	}
	2291	zProgress = Jim_GetString(objv[3], &len);
	2292	if( zProgress && len>0 ){
	2293	pDb->zProgress = Jim_Alloc( len + 1 );
	2294	memcpy(pDb->zProgress, zProgress, len+1);
	2295	}else{
	2296	pDb->zProgress = 0;
	2297	}
	2298	#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
	2299	if( pDb->zProgress ){
	2300	pDb->interp = interp;
	2301	sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
	2302	}else{
	2303	sqlite3_progress_handler(pDb->db, 0, 0, 0);
	2304	}
	2305	#endif
	2306	}else{
	2307	Jim_WrongNumArgs(interp, 2, objv, "N CALLBACK");
	2308	return JIM_ERR;
	2309	}
	2310	break;
	2311	}
	2312
	2313	/* $db profile ?CALLBACK?
	2314	**
	2315	** Make arrangements to invoke the CALLBACK routine after each SQL statement
	2316	** that has run. The text of the SQL and the amount of elapse time are
	2317	** appended to CALLBACK before the script is run.
	2318	*/
	2319	case DB_PROFILE: {
	2320	if( objc>3 ){
	2321	Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
	2322	return JIM_ERR;
	2323	}else if( objc==2 ){
	2324	if( pDb->zProfile ){
	2325	Jim_SetResultString(interp, pDb->zProfile, -1);
	2326	}
	2327	}else{
	2328	const char *zProfile;
	2329	int len;
	2330	if( pDb->zProfile ){
	2331	Jim_Free(pDb->zProfile);
	2332	}
	2333	zProfile = Jim_GetString(objv[2], &len);
	2334	if( zProfile && len>0 ){
	2335	pDb->zProfile = Jim_Alloc( len + 1 );
	2336	memcpy(pDb->zProfile, zProfile, len+1);
	2337	}else{
	2338	pDb->zProfile = 0;
	2339	}
	2340	#ifndef SQLITE_OMIT_TRACE
	2341	if( pDb->zProfile ){
	2342	pDb->interp = interp;
	2343	sqlite3_profile(pDb->db, DbProfileHandler, pDb);
	2344	}else{
	2345	sqlite3_profile(pDb->db, 0, 0);
	2346	}
	2347	#endif
	2348	}
	2349	break;
	2350	}
	2351
	2352	/*
	2353	** $db rekey KEY
	2354	**
	2355	** Change the encryption key on the currently open database.
	2356	*/
	2357	case DB_REKEY: {
	2358	int nKey;
	2359	const char *pKey;
	2360	if( objc!=3 ){
	2361	Jim_WrongNumArgs(interp, 2, objv, "KEY");
	2362	return JIM_ERR;
	2363	}
	2364	//pKey = Jim_GetByteArrayFromObj(objv[2], &nKey);
	2365	pKey = Jim_GetString(objv[2], &nKey);
	2366	#ifdef SQLITE_HAS_CODEC
	2367	rc = sqlite3_rekey(pDb->db, pKey, nKey);
	2368	if( rc ){
	2369	Jim_SetResultString(interp, sqlite3ErrStr(rc), -1);
	2370	rc = JIM_ERR;
	2371	}
	2372	#endif
	2373	break;
	2374	}
	2375
	2376	/* $db restore ?DATABASE? FILENAME
	2377	**
	2378	** Open a database file named FILENAME. Transfer the content
	2379	** of FILENAME into the local database DATABASE (default: "main").
	2380	*/
	2381	case DB_RESTORE: {
	2382	const char *zSrcFile;
	2383	const char *zDestDb;
	2384	sqlite3 *pSrc;
	2385	sqlite3_backup *pBackup;
	2386	int nTimeout = 0;
	2387
	2388	if( objc==3 ){
	2389	zDestDb = "main";
	2390	zSrcFile = Jim_String(objv[2]);
	2391	}else if( objc==4 ){
	2392	zDestDb = Jim_String(objv[2]);
	2393	zSrcFile = Jim_String(objv[3]);
	2394	}else{
	2395	Jim_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
	2396	return JIM_ERR;
	2397	}
	2398	rc = sqlite3_open_v2(zSrcFile, &pSrc, SQLITE_OPEN_READONLY, 0);
	2399	if( rc!=SQLITE_OK ){
	2400	Jim_SetResultFormatted(interp, "cannot open source database: %s", sqlite3_errmsg(pSrc));
	2401	sqlite3_close(pSrc);
	2402	return JIM_ERR;
	2403	}
	2404	pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main");
	2405	if( pBackup==0 ){
	2406	Jim_SetResultFormatted(interp, "restore failed: %s", sqlite3_errmsg(pDb->db));
	2407	sqlite3_close(pSrc);
	2408	return JIM_ERR;
	2409	}
	2410	while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK
	2411	\|\| rc==SQLITE_BUSY ){
	2412	if( rc==SQLITE_BUSY ){
	2413	if( nTimeout++ >= 3 ) break;
	2414	sqlite3_sleep(100);
	2415	}
	2416	}
	2417	sqlite3_backup_finish(pBackup);
	2418	if( rc==SQLITE_DONE ){
	2419	rc = JIM_OK;
	2420	}else if( rc==SQLITE_BUSY \|\| rc==SQLITE_LOCKED ){
	2421	Jim_SetResultString(interp, "restore failed: source database busy", -1);
	2422	rc = JIM_ERR;
	2423	}else{
	2424	Jim_SetResultFormatted(interp, "restore failed: %s", sqlite3_errmsg(pDb->db));
	2425	rc = JIM_ERR;
	2426	}
	2427	sqlite3_close(pSrc);
	2428	break;
	2429	}
	2430
	2431	/*
	2432	** $db status (step\|sort)
	2433	**
	2434	** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or
	2435	** SQLITE_STMTSTATUS_SORT for the most recent eval.
	2436	*/
	2437	case DB_STATUS: {
	2438	int v;
	2439	const char *zOp;
	2440	if( objc!=3 ){
	2441	Jim_WrongNumArgs(interp, 2, objv, "(step\|sort)");
	2442	return JIM_ERR;
	2443	}
	2444	zOp = Jim_String(objv[2]);
	2445	if( strcmp(zOp, "step")==0 ){
	2446	v = pDb->nStep;
	2447	}else if( strcmp(zOp, "sort")==0 ){
	2448	v = pDb->nSort;
	2449	}else{
	2450	Jim_SetResultString(interp, "bad argument: should be step or sort", -1);
	2451	return JIM_ERR;
	2452	}
	2453	Jim_SetResultInt(interp, v);
	2454	break;
	2455	}
	2456
	2457	/*
	2458	** $db timeout MILLESECONDS
	2459	**
	2460	** Delay for the number of milliseconds specified when a file is locked.
	2461	*/
	2462	case DB_TIMEOUT: {
	2463	long ms;
	2464	if( objc!=3 ){
	2465	Jim_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
	2466	return JIM_ERR;
	2467	}
	2468	if( Jim_GetLong(interp, objv[2], &ms) ) return JIM_ERR;
	2469	sqlite3_busy_timeout(pDb->db, ms);
	2470	break;
	2471	}
	2472
	2473	/*
	2474	** $db total_changes
	2475	**
	2476	** Return the number of rows that were modified, inserted, or deleted
	2477	** since the database handle was created.
	2478	*/
	2479	case DB_TOTAL_CHANGES: {
	2480	if( objc!=2 ){
	2481	Jim_WrongNumArgs(interp, 2, objv, "");
	2482	return JIM_ERR;
	2483	}
	2484	Jim_SetResultInt(interp, sqlite3_total_changes(pDb->db));
	2485	break;
	2486	}
	2487
	2488	/* $db trace ?CALLBACK?
	2489	**
	2490	** Make arrangements to invoke the CALLBACK routine for each SQL statement
	2491	** that is executed. The text of the SQL is appended to CALLBACK before
	2492	** it is executed.
	2493	*/
	2494	case DB_TRACE: {
	2495	if( objc>3 ){
	2496	Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
	2497	return JIM_ERR;
	2498	}else if( objc==2 ){
	2499	if( pDb->zTrace ){
	2500	Jim_AppendString(interp, Jim_GetResult(interp), pDb->zTrace, -1);
	2501	}
	2502	}else{
	2503	const char *zTrace;
	2504	int len;
	2505	if( pDb->zTrace ){
	2506	Jim_Free(pDb->zTrace);
	2507	}
	2508	zTrace = Jim_GetString(objv[2], &len);
	2509	if( zTrace && len>0 ){
	2510	pDb->zTrace = Jim_Alloc( len + 1 );
	2511	memcpy(pDb->zTrace, zTrace, len+1);
	2512	}else{
	2513	pDb->zTrace = 0;
	2514	}
	2515	#ifndef SQLITE_OMIT_TRACE
	2516	if( pDb->zTrace ){
	2517	pDb->interp = interp;
	2518	sqlite3_trace(pDb->db, DbTraceHandler, pDb);
	2519	}else{
	2520	sqlite3_trace(pDb->db, 0, 0);
	2521	}
	2522	#endif
	2523	}
	2524	break;
	2525	}
	2526
	2527	/* $db transaction [-deferred\|-immediate\|-exclusive] SCRIPT
	2528	**
	2529	** Start a new transaction (if we are not already in the midst of a
	2530	** transaction) and execute the TCL script SCRIPT. After SCRIPT
	2531	** completes, either commit the transaction or roll it back if SCRIPT
	2532	** throws an exception. Or if no new transation was started, do nothing.
	2533	** pass the exception on up the stack.
	2534	**
	2535	** This command was inspired by Dave Thomas's talk on Ruby at the
	2536	** 2005 O'Reilly Open Source Convention (OSCON).
	2537	*/
	2538	case DB_TRANSACTION: {
	2539	Jim_Obj *pScript;
	2540	const char *zBegin = "SAVEPOINT _tcl_transaction";
	2541	if( objc!=3 && objc!=4 ){
	2542	Jim_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
	2543	return JIM_ERR;
	2544	}
	2545
	2546	if( pDb->nTransaction==0 && objc==4 ){
	2547	static const char *TTYPE_strs[] = {
	2548	"deferred", "exclusive", "immediate", 0
	2549	};
	2550	enum TTYPE_enum {
	2551	TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
	2552	};
	2553	int ttype;
	2554	if( Jim_GetEnum(interp, objv[2], TTYPE_strs, &ttype, "transaction type", JIM_ERRMSG \| JIM_ENUM_ABBREV) ){
	2555	return JIM_ERR;
	2556	}
	2557	switch( (enum TTYPE_enum)ttype ){
	2558	case TTYPE_DEFERRED: /* no-op */; break;
	2559	case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break;
	2560	case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break;
	2561	}
	2562	}
	2563	pScript = objv[objc-1];
	2564
	2565	/* Run the SQLite BEGIN command to open a transaction or savepoint. */
	2566	pDb->disableAuth++;
	2567	rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
	2568	pDb->disableAuth--;
	2569	if( rc!=SQLITE_OK ){
	2570	Jim_SetResultString(interp, sqlite3_errmsg(pDb->db), -1);
	2571	return JIM_ERR;
	2572	}
	2573	pDb->nTransaction++;
	2574
	2575	/* No NRE in Jim Tcl, so evaluate the script directly, then
	2576	** call function DbTransPostCmd() to commit (or rollback) the transaction
	2577	** or savepoint. */
	2578	rc = DbTransPostCmd(interp, pDb, Jim_EvalObj(interp, pScript));
	2579	break;
	2580	}
	2581
	2582	/*
	2583	** $db unlock_notify ?script?
	2584	*/
	2585	case DB_UNLOCK_NOTIFY: {
	2586	#ifndef SQLITE_ENABLE_UNLOCK_NOTIFY
	2587	Jim_SetResultString(interp, "unlock_notify not available in this build", -1);
	2588	rc = JIM_ERR;
	2589	#else
	2590	if( objc!=2 && objc!=3 ){
	2591	Jim_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
	2592	rc = JIM_ERR;
	2593	}else{
	2594	void (xNotify)(void *, int) = 0;
	2595	void *pNotifyArg = 0;
	2596
	2597	if( pDb->pUnlockNotify ){
	2598	Jim_DecrRefCount(interp, pDb->pUnlockNotify);
	2599	pDb->pUnlockNotify = 0;
	2600	}
	2601
	2602	if( objc==3 ){
	2603	xNotify = DbUnlockNotify;
	2604	pNotifyArg = (void *)pDb;
	2605	pDb->pUnlockNotify = objv[2];
	2606	Jim_IncrRefCount(pDb->pUnlockNotify);
	2607	}
	2608
	2609	if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){
	2610	Jim_SetResultString(interp, sqlite3_errmsg(pDb->db), -1);
	2611	rc = JIM_ERR;
	2612	}
	2613	}
	2614	#endif
	2615	break;
	2616	}
	2617
	2618	/*
	2619	** $db update_hook ?script?
	2620	** $db rollback_hook ?script?
	2621	*/
	2622	case DB_UPDATE_HOOK:
	2623	case DB_ROLLBACK_HOOK: {
	2624
	2625	/* set ppHook to point at pUpdateHook or pRollbackHook, depending on
	2626	** whether [$db update_hook] or [$db rollback_hook] was invoked.
	2627	*/
	2628	Jim_Obj **ppHook;
	2629	if( choice==DB_UPDATE_HOOK ){
	2630	ppHook = &pDb->pUpdateHook;
	2631	}else{
	2632	ppHook = &pDb->pRollbackHook;
	2633	}
	2634
	2635	if( objc!=2 && objc!=3 ){
	2636	Jim_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
	2637	return JIM_ERR;
	2638	}
	2639	if( *ppHook ){
	2640	Jim_SetResult(interp, *ppHook);
	2641	if( objc==3 ){
	2642	Jim_DecrRefCount(interp, *ppHook);
	2643	*ppHook = 0;
	2644	}
	2645	}
	2646	if( objc==3 ){
	2647	assert( !(*ppHook) );
	2648	if( Jim_Length(objv[2])>0 ){
	2649	*ppHook = objv[2];
	2650	Jim_IncrRefCount(*ppHook);
	2651	}
	2652	}
	2653
	2654	sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
	2655	sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb);
	2656
	2657	break;
	2658	}
	2659
	2660	/* $db version
	2661	**
	2662	** Return the version string for this database.
	2663	*/
	2664	case DB_VERSION: {
	2665	Jim_SetResultString(interp, sqlite3_libversion(), -1);
	2666	break;
	2667	}
	2668
	2669
	2670	} /* End of the SWITCH statement */
	2671	return rc;
	2672	}
	2673
	2674	/*
	2675	** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
	2676	** ?-create BOOLEAN? ?-nomutex BOOLEAN?
	2677	**
	2678	** This is the main Tcl command. When the "sqlite" Tcl command is
	2679	** invoked, this routine runs to process that command.
	2680	**
	2681	** The first argument, DBNAME, is an arbitrary name for a new
	2682	** database connection. This command creates a new command named
	2683	** DBNAME that is used to control that connection. The database
	2684	** connection is deleted when the DBNAME command is deleted.
	2685	**
	2686	** The second argument is the name of the database file.
	2687	**
	2688	*/
	2689	static int DbMain(Jim_Interp interp, int objc, Jim_Obj const*objv){
	2690	SqliteDb *p;
	2691	const char *pKey = 0;
	2692	int nKey = 0;
	2693	const char *zArg;
	2694	char *zErrMsg;
	2695	int i;
	2696	const char *zFile;
	2697	const char *zVfs = 0;
	2698	int flags;
	2699
	2700	/* Not threading in Jim, so no mutexing is needed */
	2701	flags = SQLITE_OPEN_READWRITE \| SQLITE_OPEN_CREATE \| SQLITE_OPEN_NOMUTEX;
	2702
	2703	if( objc==2 ){
	2704	zArg = Jim_String(objv[1]);
	2705	if( strcmp(zArg,"-version")==0 ){
	2706	Jim_SetResultString(interp, sqlite3_version, -1);
	2707	return JIM_OK;
	2708	}
	2709	if( strcmp(zArg,"-has-codec")==0 ){
	2710	#ifdef SQLITE_HAS_CODEC
	2711	Jim_SetResultInt(interp, 1);
	2712	#else
	2713	Jim_SetResultInt(interp, 0);
	2714	#endif
	2715	return JIM_OK;
	2716	}
	2717	}
	2718	for(i=3; i+1<objc; i+=2){
	2719	zArg = Jim_String(objv[i]);
	2720	if( strcmp(zArg,"-key")==0 ){
	2721	pKey = Jim_GetString(objv[i+1], &nKey);
	2722	}else if( strcmp(zArg, "-vfs")==0 ){
	2723	i++;
	2724	zVfs = Jim_String(objv[i]);
	2725	}else if( strcmp(zArg, "-readonly")==0 ){
	2726	long b;
	2727	if( Jim_GetLong(interp, objv[i+1], &b) ) return JIM_ERR;
	2728	if( b ){
	2729	flags &= ~(SQLITE_OPEN_READWRITE\|SQLITE_OPEN_CREATE);
	2730	flags \|= SQLITE_OPEN_READONLY;
	2731	}else{
	2732	flags &= ~SQLITE_OPEN_READONLY;
	2733	flags \|= SQLITE_OPEN_READWRITE;
	2734	}
	2735	}else if( strcmp(zArg, "-create")==0 ){
	2736	long b;
	2737	if( Jim_GetLong(interp, objv[i+1], &b) ) return JIM_ERR;
	2738	if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
	2739	flags \|= SQLITE_OPEN_CREATE;
	2740	}else{
	2741	flags &= ~SQLITE_OPEN_CREATE;
	2742	}
	2743	}else if( strcmp(zArg, "-nomutex")==0 ){
	2744	long b;
	2745	if( Jim_GetLong(interp, objv[i+1], &b) ) return JIM_ERR;
	2746	if( b ){
	2747	flags \|= SQLITE_OPEN_NOMUTEX;
	2748	flags &= ~SQLITE_OPEN_FULLMUTEX;
	2749	}else{
	2750	flags &= ~SQLITE_OPEN_NOMUTEX;
	2751	}
	2752	}else if( strcmp(zArg, "-fullmutex")==0 ){
	2753	long b;
	2754	if( Jim_GetLong(interp, objv[i+1], &b) ) return JIM_ERR;
	2755	if( b ){
	2756	flags \|= SQLITE_OPEN_FULLMUTEX;
	2757	flags &= ~SQLITE_OPEN_NOMUTEX;
	2758	}else{
	2759	flags &= ~SQLITE_OPEN_FULLMUTEX;
	2760	}
	2761	}else{
	2762	Jim_SetResultFormatted(interp, "unknown option: %s", zArg);
	2763	return JIM_ERR;
	2764	}
	2765	}
	2766	if( objc<3 \|\| (objc&1)!=1 ){
	2767	Jim_WrongNumArgs(interp, 1, objv,
	2768	"HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
	2769	" ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?"
	2770	#ifdef SQLITE_HAS_CODEC
	2771	" ?-key CODECKEY?"
	2772	#endif
	2773	);
	2774	return JIM_ERR;
	2775	}
	2776	zErrMsg = 0;
	2777	p = (SqliteDb)Jim_Alloc( sizeof(p) );
	2778	memset(p, 0, sizeof(*p));
	2779	zFile = Jim_String(objv[2]);
	2780	sqlite3_open_v2(zFile, &p->db, flags, zVfs);
	2781	if( SQLITE_OK!=sqlite3_errcode(p->db) ){
	2782	zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
	2783	sqlite3_close(p->db);
	2784	p->db = 0;
	2785	}
	2786	#ifdef SQLITE_HAS_CODEC
	2787	if( p->db ){
	2788	sqlite3_key(p->db, pKey, nKey);
	2789	}
	2790	#endif
	2791	if( p->db==0 ){
	2792	Jim_SetResultString(interp, zErrMsg, -1);
	2793	Jim_Free((char*)p);
	2794	sqlite3_free(zErrMsg);
	2795	return JIM_ERR;
	2796	}
	2797	p->maxStmt = NUM_PREPARED_STMTS;
	2798	p->interp = interp;
	2799	zArg = Jim_String(objv[1]);
	2800	Jim_CreateCommand(interp, zArg, DbObjCmd, p, DbDeleteCmd);
	2801	return JIM_OK;
	2802	}
	2803
	2804	/*
	2805	** Make sure we have a PACKAGE_VERSION macro defined. This will be
	2806	** defined automatically by the TEA makefile. But other makefiles
	2807	** do not define it.
	2808	*/
	2809	#ifndef PACKAGE_VERSION
	2810	# define PACKAGE_VERSION SQLITE_VERSION
	2811	#endif
	2812
	2813	#define EXTERN
	2814	/*
	2815	** Initialize this module.
	2816	**
	2817	** This Tcl module contains only a single new Tcl command named "sqlite".
	2818	** (Hence there is no namespace. There is no point in using a namespace
	2819	** if the extension only supplies one new name!) The "sqlite" command is
	2820	** used to open a new SQLite database. See the DbMain() routine above
	2821	** for additional information.
	2822	*/
	2823	EXTERN int Jim_sqliteInit(Jim_Interp *interp){
	2824	Jim_PackageProvideCheck(interp, "sqlite");
	2825	Jim_CreateCommand(interp, "sqlite", DbMain, 0, 0);
	2826	return JIM_OK;
	2827	}

-2830

~~sqlite3/jim-sqlite3.c~~ less more

0		/* Jim Tcl version of the sqlite3 Tcl binding.
1		* From sqlite3 3.6.22
2		*
3		* This version is (c) Steve Bennett <steveb@workware.net.au>
4		* Copyright of the original version is below.
5		*/
6
7		/*
8		** 2001 September 15
9		**
10		** The author disclaims copyright to this source code. In place of
11		** a legal notice, here is a blessing:
12		**
13		** May you do good and not evil.
14		** May you find forgiveness for yourself and forgive others.
15		** May you share freely, never taking more than you give.
16		**
17		*************************************************************************
18		** A TCL Interface to SQLite. Append this file to sqlite3.c and
19		** compile the whole thing to build a TCL-enabled version of SQLite.
20		**
21		** Compile-time options:
22		**
23		** -D SQLITE_TEST When used in conjuction with -DTCLSH=1, add
24		** hundreds of new commands used for testing
25		** SQLite. This option implies -DSQLITE_TCLMD5.
26		*/
27		#include <jim.h>
28		#include <jim-config.h>
29		#include <jim-eventloop.h>
30		#include <errno.h>
31
32		/*
33		** Some additional include files are needed if this file is not
34		** appended to the amalgamation.
35		*/
36		#ifndef SQLITE_AMALGAMATION
37		# include "sqlite3.h"
38		# include <stdlib.h>
39		# include <string.h>
40		# include <assert.h>
41		typedef unsigned char u8;
42		#endif
43		#include <ctype.h>
44
45		#define NUM_PREPARED_STMTS 10
46		#define MAX_PREPARED_STMTS 100
47
48		/*
49		** If Jim Tcl uses UTF-8 and SQLite is configured to use iso8859, then we
50		#ifdef JIM_UTF8
51		#define SQLITE_UTF8
52		#endif
53
54		** have to do a translation when going between the two. Set the
55		** UTF_TRANSLATION_NEEDED macro to indicate that we need to do
56		** this translation.
57		*/
58		#if defined(JIM_UTF8) && !defined(SQLITE_UTF8)
59		# define UTF_TRANSLATION_NEEDED 1
60		# warning Jim Tcl can not translate encoding from iso8859 to utf-8
61		#endif
62
63		/*
64		** New SQL functions can be created as TCL scripts. Each such function
65		** is described by an instance of the following structure.
66		*/
67		typedef struct SqlFunc SqlFunc;
68		struct SqlFunc {
69		Jim_Interp interp; / The TCL interpret to execute the function */
70		Jim_Obj pScript; / The Jim_Obj representation of the script */
71		int useEvalObjv; /* True if it is safe to use Jim_EvalObjv */
72		char zName; / Name of this function */
73		SqlFunc pNext; / Next function on the list of them all */
74		};
75
76		/*
77		** New collation sequences function can be created as TCL scripts. Each such
78		** function is described by an instance of the following structure.
79		*/
80		typedef struct SqlCollate SqlCollate;
81		struct SqlCollate {
82		Jim_Interp interp; / The TCL interpret to execute the function */
83		char zScript; / The script to be run */
84		SqlCollate pNext; / Next function on the list of them all */
85		};
86
87		/*
88		** Prepared statements are cached for faster execution. Each prepared
89		** statement is described by an instance of the following structure.
90		*/
91		typedef struct SqlPreparedStmt SqlPreparedStmt;
92		struct SqlPreparedStmt {
93		SqlPreparedStmt pNext; / Next in linked list */
94		SqlPreparedStmt pPrev; / Previous on the list */
95		sqlite3_stmt pStmt; / The prepared statement */
96		int nSql; /* chars in zSql[] */
97		const char zSql; / Text of the SQL statement */
98		int nParm; /* Size of apParm array */
99		Jim_Obj *apParm; / Array of referenced object pointers */
100		};
101
102		typedef struct IncrblobChannel IncrblobChannel;
103
104		/*
105		** There is one instance of this structure for each SQLite database
106		** that has been opened by the SQLite TCL interface.
107		*/
108		typedef struct SqliteDb SqliteDb;
109		struct SqliteDb {
110		sqlite3 db; / The "real" database structure. MUST BE FIRST */
111		Jim_Interp interp; / The interpreter used for this database */
112		char zBusy; / The busy callback routine */
113		char zCommit; / The commit hook callback routine */
114		char zTrace; / The trace callback routine */
115		char zProfile; / The profile callback routine */
116		char zProgress; / The progress callback routine */
117		char zAuth; / The authorization callback routine */
118		int disableAuth; /* Disable the authorizer if it exists */
119		char zNull; / Text to substitute for an SQL NULL value */
120		SqlFunc pFunc; / List of SQL functions */
121		Jim_Obj pUpdateHook; / Update hook script (if any) */
122		Jim_Obj pRollbackHook; / Rollback hook script (if any) */
123		Jim_Obj pUnlockNotify; / Unlock notify script (if any) */
124		SqlCollate pCollate; / List of SQL collation functions */
125		int rc; /* Return code of most recent sqlite3_exec() */
126		Jim_Obj pCollateNeeded; / Collation needed script */
127		SqlPreparedStmt stmtList; / List of prepared statements*/
128		SqlPreparedStmt stmtLast; / Last statement in the list */
129		int maxStmt; /* The next maximum number of stmtList */
130		int nStmt; /* Number of statements in stmtList */
131		IncrblobChannel pIncrblob;/ Linked list of open incrblob channels */
132		int nStep, nSort; /* Statistics for most recent operation */
133		int nTransaction; /* Number of nested [transaction] methods */
134		};
135
136		struct IncrblobChannel {
137		sqlite3_blob pBlob; / sqlite3 blob handle */
138		SqliteDb pDb; / Associated database connection */
139		int iSeek; /* Current seek offset */
140		Jim_Obj channel; / Channel identifier */
141		IncrblobChannel pNext; / Linked list of all open incrblob channels */
142		IncrblobChannel pPrev; / Linked list of all open incrblob channels */
143		};
144
145		/*
146		** Compute a string length that is limited to what can be stored in
147		** lower 30 bits of a 32-bit signed integer.
148		*/
149		static int strlen30(const char *z){
150		const char *z2 = z;
151		while( *z2 ){ z2++; }
152		return 0x3fffffff & (int)(z2 - z);
153		}
154
155
156		#ifndef SQLITE_OMIT_INCRBLOB
157		/*
158		** Close all incrblob channels opened using database connection pDb.
159		** This is called when shutting down the database connection.
160		*/
161		static void closeIncrblobChannels(SqliteDb *pDb){
162		IncrblobChannel *p;
163		IncrblobChannel *pNext;
164
165		for(p=pDb->pIncrblob; p; p=pNext){
166		pNext = p->pNext;
167
168		/* Note: Calling unregister here call Jim_Close on the incrblob channel,
169		** which deletes the IncrblobChannel structure at *p. So do not
170		** call Jim_Free() here.
171		*/
172		Jim_UnregisterChannel(pDb->interp, p->channel);
173		}
174		}
175
176		/*
177		** Close an incremental blob channel.
178		*/
179		static int incrblobClose(ClientData instanceData, Jim_Interp *interp){
180		IncrblobChannel p = (IncrblobChannel )instanceData;
181		int rc = sqlite3_blob_close(p->pBlob);
182		sqlite3 *db = p->pDb->db;
183
184		/* Remove the channel from the SqliteDb.pIncrblob list. */
185		if( p->pNext ){
186		p->pNext->pPrev = p->pPrev;
187		}
188		if( p->pPrev ){
189		p->pPrev->pNext = p->pNext;
190		}
191		if( p->pDb->pIncrblob==p ){
192		p->pDb->pIncrblob = p->pNext;
193		}
194
195		/* Free the IncrblobChannel structure */
196		Jim_Free((char *)p);
197
198		if( rc!=SQLITE_OK ){
199		Jim_SetResult(interp, (char *)sqlite3_errmsg(db), JIM_VOLATILE);
200		return JIM_ERR;
201		}
202		return JIM_OK;
203		}
204
205		/*
206		** Read data from an incremental blob channel.
207		*/
208		static int incrblobInput(
209		ClientData instanceData,
210		char *buf,
211		int bufSize,
212		int *errorCodePtr
213		){
214		IncrblobChannel p = (IncrblobChannel )instanceData;
215		int nRead = bufSize; /* Number of bytes to read */
216		int nBlob; /* Total size of the blob */
217		int rc; /* sqlite error code */
218
219		nBlob = sqlite3_blob_bytes(p->pBlob);
220		if( (p->iSeek+nRead)>nBlob ){
221		nRead = nBlob-p->iSeek;
222		}
223		if( nRead<=0 ){
224		return 0;
225		}
226
227		rc = sqlite3_blob_read(p->pBlob, (void *)buf, nRead, p->iSeek);
228		if( rc!=SQLITE_OK ){
229		*errorCodePtr = rc;
230		return -1;
231		}
232
233		p->iSeek += nRead;
234		return nRead;
235		}
236
237		/*
238		** Write data to an incremental blob channel.
239		*/
240		static int incrblobOutput(
241		ClientData instanceData,
242		CONST char *buf,
243		int toWrite,
244		int *errorCodePtr
245		){
246		IncrblobChannel p = (IncrblobChannel )instanceData;
247		int nWrite = toWrite; /* Number of bytes to write */
248		int nBlob; /* Total size of the blob */
249		int rc; /* sqlite error code */
250
251		nBlob = sqlite3_blob_bytes(p->pBlob);
252		if( (p->iSeek+nWrite)>nBlob ){
253		*errorCodePtr = EINVAL;
254		return -1;
255		}
256		if( nWrite<=0 ){
257		return 0;
258		}
259
260		rc = sqlite3_blob_write(p->pBlob, (void *)buf, nWrite, p->iSeek);
261		if( rc!=SQLITE_OK ){
262		*errorCodePtr = EIO;
263		return -1;
264		}
265
266		p->iSeek += nWrite;
267		return nWrite;
268		}
269
270		/*
271		** Seek an incremental blob channel.
272		*/
273		static int incrblobSeek(
274		ClientData instanceData,
275		long offset,
276		int seekMode,
277		int *errorCodePtr
278		){
279		IncrblobChannel p = (IncrblobChannel )instanceData;
280
281		switch( seekMode ){
282		case SEEK_SET:
283		p->iSeek = offset;
284		break;
285		case SEEK_CUR:
286		p->iSeek += offset;
287		break;
288		case SEEK_END:
289		p->iSeek = sqlite3_blob_bytes(p->pBlob) + offset;
290		break;
291
292		default: assert(!"Bad seekMode");
293		}
294
295		return p->iSeek;
296		}
297
298
299		static void incrblobWatch(ClientData instanceData, int mode){
300		/* NO-OP */
301		}
302		static int incrblobHandle(ClientData instanceData, int dir, ClientData *hPtr){
303		return JIM_ERR;
304		}
305
306		static Jim_ChannelType IncrblobChannelType = {
307		"incrblob", /* typeName */
308		JIM_CHANNEL_VERSION_2, /* version */
309		incrblobClose, /* closeProc */
310		incrblobInput, /* inputProc */
311		incrblobOutput, /* outputProc */
312		incrblobSeek, /* seekProc */
313		0, /* setOptionProc */
314		0, /* getOptionProc */
315		incrblobWatch, /* watchProc (this is a no-op) */
316		incrblobHandle, /* getHandleProc (always returns error) */
317		0, /* close2Proc */
318		0, /* blockModeProc */
319		0, /* flushProc */
320		0, /* handlerProc */
321		0, /* wideSeekProc */
322		};
323
324		/*
325		** Create a new incrblob channel.
326		*/
327		static int createIncrblobChannel(
328		Jim_Interp *interp,
329		SqliteDb *pDb,
330		const char *zDb,
331		const char *zTable,
332		const char *zColumn,
333		sqlite_int64 iRow,
334		int isReadonly
335		){
336		IncrblobChannel *p;
337		sqlite3 *db = pDb->db;
338		sqlite3_blob *pBlob;
339		int rc;
340		int flags = JIM_READABLE\|(isReadonly ? 0 : JIM_WRITABLE);
341
342		/* This variable is used to name the channels: "incrblob_[incr count]" */
343		static int count = 0;
344		char zChannel[64];
345
346		rc = sqlite3_blob_open(db, zDb, zTable, zColumn, iRow, !isReadonly, &pBlob);
347		if( rc!=SQLITE_OK ){
348		Jim_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), JIM_VOLATILE);
349		return JIM_ERR;
350		}
351
352		p = (IncrblobChannel *)Jim_Alloc(sizeof(IncrblobChannel));
353		p->iSeek = 0;
354		p->pBlob = pBlob;
355
356		sqlite3_snprintf(sizeof(zChannel), zChannel, "incrblob_%d", ++count);
357		p->channel = Jim_CreateChannel(&IncrblobChannelType, zChannel, p, flags);
358		Jim_RegisterChannel(interp, p->channel);
359
360		/* Link the new channel into the SqliteDb.pIncrblob list. */
361		p->pNext = pDb->pIncrblob;
362		p->pPrev = 0;
363		if( p->pNext ){
364		p->pNext->pPrev = p;
365		}
366		pDb->pIncrblob = p;
367		p->pDb = pDb;
368
369		Jim_SetResult(interp, (char *)Jim_GetChannelName(p->channel), JIM_VOLATILE);
370		return JIM_OK;
371		}
372		#else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */
373		#define closeIncrblobChannels(pDb)
374		#endif
375
376		/*
377		** Look at the script prefix in pCmd. We will be executing this script
378		** after first appending one or more arguments. This routine analyzes
379		** the script to see if it is safe to use Jim_EvalObjv() on the script
380		** rather than the more general Jim_EvalEx(). Jim_EvalObjv() is much
381		** faster.
382		**
383		** Scripts that are safe to use with Jim_EvalObjv() consists of a
384		** command name followed by zero or more arguments with no [...] or $
385		** or {...} or ; to be seen anywhere. Most callback scripts consist
386		** of just a single procedure name and they meet this requirement.
387		*/
388		static int safeToUseEvalObjv(Jim_Interp interp, Jim_Obj pCmd){
389		/* We could try to do something with Jim_Parse(). But we will instead
390		** just do a search for forbidden characters. If any of the forbidden
391		** characters appear in pCmd, we will report the string as unsafe.
392		*/
393		const char *z;
394		int n;
395		z = Jim_GetString(pCmd, &n);
396		while( n-- > 0 ){
397		int c = *(z++);
398		if( c=='$' \|\| c=='[' \|\| c==';' ) return 0;
399		}
400		return 1;
401		}
402
403		/*
404		** Find an SqlFunc structure with the given name. Or create a new
405		** one if an existing one cannot be found. Return a pointer to the
406		** structure.
407		*/
408		static SqlFunc findSqlFunc(SqliteDb pDb, const char *zName){
409		SqlFunc p, pNew;
410		int i;
411		pNew = (SqlFunc)Jim_Alloc( sizeof(pNew) + strlen30(zName) + 1 );
412		pNew->zName = (char*)&pNew[1];
413		for(i=0; zName[i]; i++){ pNew->zName[i] = tolower((unsigned)zName[i]); }
414		pNew->zName[i] = 0;
415		for(p=pDb->pFunc; p; p=p->pNext){
416		if( strcmp(p->zName, pNew->zName)==0 ){
417		Jim_Free((char*)pNew);
418		return p;
419		}
420		}
421		pNew->interp = pDb->interp;
422		pNew->pScript = 0;
423		pNew->pNext = pDb->pFunc;
424		pDb->pFunc = pNew;
425		return pNew;
426		}
427
428		/*
429		** Finalize and free a list of prepared statements
430		*/
431		static void flushStmtCache( SqliteDb *pDb ){
432		SqlPreparedStmt *pPreStmt;
433
434		while( pDb->stmtList ){
435		sqlite3_finalize( pDb->stmtList->pStmt );
436		pPreStmt = pDb->stmtList;
437		pDb->stmtList = pDb->stmtList->pNext;
438		Jim_Free( (char*)pPreStmt );
439		}
440		pDb->nStmt = 0;
441		pDb->stmtLast = 0;
442		}
443
444		/*
445		** TCL calls this procedure when an sqlite3 database command is
446		** deleted.
447		*/
448		static void DbDeleteCmd(Jim_Interp interp, void db){
449		SqliteDb pDb = (SqliteDb)db;
450		flushStmtCache(pDb);
451		closeIncrblobChannels(pDb);
452		sqlite3_close(pDb->db);
453		while( pDb->pFunc ){
454		SqlFunc *pFunc = pDb->pFunc;
455		pDb->pFunc = pFunc->pNext;
456		Jim_DecrRefCount(interp, pFunc->pScript);
457		Jim_Free((char*)pFunc);
458		}
459		while( pDb->pCollate ){
460		SqlCollate *pCollate = pDb->pCollate;
461		pDb->pCollate = pCollate->pNext;
462		Jim_Free((char*)pCollate);
463		}
464		if( pDb->zBusy ){
465		Jim_Free(pDb->zBusy);
466		}
467		if( pDb->zTrace ){
468		Jim_Free(pDb->zTrace);
469		}
470		if( pDb->zProfile ){
471		Jim_Free(pDb->zProfile);
472		}
473		if( pDb->zAuth ){
474		Jim_Free(pDb->zAuth);
475		}
476		if( pDb->zNull ){
477		Jim_Free(pDb->zNull);
478		}
479		if( pDb->pUpdateHook ){
480		Jim_DecrRefCount(interp, pDb->pUpdateHook);
481		}
482		if( pDb->pRollbackHook ){
483		Jim_DecrRefCount(interp, pDb->pRollbackHook);
484		}
485		if( pDb->pCollateNeeded ){
486		Jim_DecrRefCount(interp, pDb->pCollateNeeded);
487		}
488		Jim_Free((char*)pDb);
489		}
490
491		/*
492		** This routine is called when a database file is locked while trying
493		** to execute SQL.
494		*/
495		static int DbBusyHandler(void *cd, int nTries){
496		SqliteDb pDb = (SqliteDb)cd;
497		int rc;
498		char zVal[30];
499		Jim_Obj *objPtr;
500
501		sqlite3_snprintf(sizeof(zVal), zVal, "%d", nTries);
502
503		objPtr = Jim_NewStringObj(pDb->interp, pDb->zBusy, -1);
504		Jim_AppendStrings(pDb->interp, objPtr, " ", zVal, NULL);
505		rc = Jim_EvalObj(pDb->interp, objPtr);
506		if( rc!=JIM_OK \|\| atoi(Jim_String(Jim_GetResult(pDb->interp))) ){
507		return 0;
508		}
509		return 1;
510		}
511
512		#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
513		/*
514		** This routine is invoked as the 'progress callback' for the database.
515		*/
516		static int DbProgressHandler(void *cd){
517		SqliteDb pDb = (SqliteDb)cd;
518		int rc;
519
520		assert( pDb->zProgress );
521		rc = Jim_Eval(pDb->interp, pDb->zProgress);
522		if( rc!=JIM_OK \|\| atoi(Jim_String(Jim_GetResult(pDb->interp))) ){
523		return 1;
524		}
525		return 0;
526		}
527		#endif
528
529		#ifndef SQLITE_OMIT_TRACE
530		/*
531		** This routine is called by the SQLite trace handler whenever a new
532		** block of SQL is executed. The TCL script in pDb->zTrace is executed.
533		*/
534		static void DbTraceHandler(void cd, const char zSql){
535		SqliteDb pDb = (SqliteDb)cd;
536
537		Jim_Obj *str = Jim_NewStringObj(pDb->interp, pDb->zTrace, -1);
538		Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zSql, -1));
539		Jim_Eval(pDb->interp, zSql);
540		Jim_SetEmptyResult(pDb->interp);
541		}
542		#endif
543
544		#ifndef SQLITE_OMIT_TRACE
545		/*
546		** This routine is called by the SQLite profile handler after a statement
547		** SQL has executed. The TCL script in pDb->zProfile is evaluated.
548		*/
549		static void DbProfileHandler(void cd, const char zSql, sqlite_uint64 tm){
550		SqliteDb pDb = (SqliteDb)cd;
551		Jim_Obj *str;
552		char zTm[100];
553
554		sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm);
555		str = Jim_NewStringObj(pDb->interp, pDb->zProfile, -1);
556		Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zSql, -1));
557		Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zTm, -1));
558		Jim_EvalObj(pDb->interp, str);
559		Jim_SetEmptyResult(pDb->interp);
560		}
561		#endif
562
563		/*
564		** This routine is called when a transaction is committed. The
565		** TCL script in pDb->zCommit is executed. If it returns non-zero or
566		** if it throws an exception, the transaction is rolled back instead
567		** of being committed.
568		*/
569		static int DbCommitHandler(void *cd){
570		SqliteDb pDb = (SqliteDb)cd;
571		int rc;
572
573		rc = Jim_Eval(pDb->interp, pDb->zCommit);
574		if( rc!=JIM_OK \|\| atoi(Jim_String(Jim_GetResult(pDb->interp))) ){
575		return 1;
576		}
577		return 0;
578		}
579
580		static void DbRollbackHandler(void *clientData){
581		SqliteDb pDb = (SqliteDb)clientData;
582		assert(pDb->pRollbackHook);
583		Jim_EvalObjBackground(pDb->interp, pDb->pRollbackHook);
584		}
585
586		#if defined(SQLITE_TEST) && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
587		static void setTestUnlockNotifyVars(Jim_Interp *interp, int iArg, int nArg){
588		char zBuf[64];
589		sprintf(zBuf, "%d", iArg);
590		Jim_SetVar(interp, "sqlite_unlock_notify_arg", zBuf, JIM_GLOBAL_ONLY);
591		sprintf(zBuf, "%d", nArg);
592		Jim_SetVar(interp, "sqlite_unlock_notify_argcount", zBuf, JIM_GLOBAL_ONLY);
593		}
594		#else
595		# define setTestUnlockNotifyVars(x,y,z)
596		#endif
597
598		#ifdef SQLITE_ENABLE_UNLOCK_NOTIFY
599		static void DbUnlockNotify(void **apArg, int nArg){
600		int i;
601		for(i=0; i<nArg; i++){
602		const int flags = (JIM_EVAL_GLOBAL\|JIM_EVAL_DIRECT);
603		SqliteDb pDb = (SqliteDb )apArg[i];
604		setTestUnlockNotifyVars(pDb->interp, i, nArg);
605		assert( pDb->pUnlockNotify);
606		Jim_EvalObjEx(pDb->interp, pDb->pUnlockNotify, flags);
607		Jim_DecrRefCount(interp, pDb->pUnlockNotify);
608		pDb->pUnlockNotify = 0;
609		}
610		}
611		#endif
612
613		static void DbUpdateHandler(
614		void *p,
615		int op,
616		const char *zDb,
617		const char *zTbl,
618		sqlite_int64 rowid
619		){
620		SqliteDb pDb = (SqliteDb )p;
621		Jim_Obj *pCmd;
622
623		assert( pDb->pUpdateHook );
624		assert( op==SQLITE_INSERT \|\| op==SQLITE_UPDATE \|\| op==SQLITE_DELETE );
625
626		pCmd = Jim_DuplicateObj(pDb->interp, pDb->pUpdateHook);
627		Jim_IncrRefCount(pCmd);
628		Jim_ListAppendElement(0, pCmd, Jim_NewStringObj(pDb->interp,
629		( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1));
630		Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewStringObj(pDb->interp, zDb, -1));
631		Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewStringObj(pDb->interp, zTbl, -1));
632		Jim_ListAppendElement(pDb->interp, pCmd, Jim_NewIntObj(pDb->interp, rowid));
633		Jim_EvalObj(pDb->interp, pCmd);
634		}
635
636		static void tclCollateNeeded(
637		void *pCtx,
638		sqlite3 *db,
639		int enc,
640		const char *zName
641		){
642		SqliteDb pDb = (SqliteDb )pCtx;
643		Jim_Obj *pScript = Jim_DuplicateObj(pDb->interp, pDb->pCollateNeeded);
644		//Jim_IncrRefCount(pScript);
645		Jim_ListAppendElement(pDb->interp, pScript, Jim_NewStringObj(pDb->interp, zName, -1));
646		Jim_EvalObj(pDb->interp, pScript);
647		//Jim_DecrRefCount(pDb->interp, pScript);
648		}
649
650		/*
651		** This routine is called to evaluate an SQL collation function implemented
652		** using TCL script.
653		*/
654		static int tclSqlCollate(
655		void *pCtx,
656		int nA,
657		const void *zA,
658		int nB,
659		const void *zB
660		){
661		SqlCollate p = (SqlCollate )pCtx;
662		Jim_Obj *pCmd;
663
664		pCmd = Jim_NewStringObj(p->interp, p->zScript, -1);
665		//Jim_IncrRefCount(pCmd);
666		Jim_ListAppendElement(p->interp, pCmd, Jim_NewStringObj(p->interp, zA, nA));
667		Jim_ListAppendElement(p->interp, pCmd, Jim_NewStringObj(p->interp, zB, nB));
668		Jim_EvalObj(p->interp, pCmd);
669		//Jim_DecrRefCount(interp, pCmd);
670		return (atoi(Jim_String(Jim_GetResult(p->interp))));
671		}
672
673		/*
674		** This routine is called to evaluate an SQL function implemented
675		** using TCL script.
676		*/
677		static void tclSqlFunc(sqlite3_context context, int argc, sqlite3_value*argv){
678		SqlFunc *p = sqlite3_user_data(context);
679		Jim_Obj *pCmd;
680		int i;
681		int rc;
682
683		if( argc==0 ){
684		/* If there are no arguments to the function, call Jim_EvalObjEx on the
685		** script object directly. This allows the TCL compiler to generate
686		** bytecode for the command on the first invocation and thus make
687		** subsequent invocations much faster. */
688		pCmd = p->pScript;
689		//Jim_IncrRefCount(pCmd);
690		rc = Jim_EvalObj(p->interp, pCmd);
691		//Jim_DecrRefCount(interp, pCmd);
692		}else{
693		/* If there are arguments to the function, make a shallow copy of the
694		** script object, lappend the arguments, then evaluate the copy.
695		**
696		** By "shallow" copy, we mean a only the outer list Jim_Obj is duplicated.
697		** The new Jim_Obj contains pointers to the original list elements.
698		** That way, when Jim_EvalObjv() is run and shimmers the first element
699		** of the list to tclCmdNameType, that alternate representation will
700		** be preserved and reused on the next invocation.
701		*/
702		pCmd = Jim_DuplicateObj(p->interp, p->pScript);
703		Jim_IncrRefCount(pCmd);
704		for(i=0; i<argc; i++){
705		sqlite3_value *pIn = argv[i];
706		Jim_Obj *pVal;
707
708		/* Set pVal to contain the i'th column of this row. */
709		switch( sqlite3_value_type(pIn) ){
710		case SQLITE_BLOB: {
711		int bytes = sqlite3_value_bytes(pIn);
712		pVal = Jim_NewStringObj(p->interp, sqlite3_value_blob(pIn), bytes);
713		break;
714		}
715		case SQLITE_INTEGER: {
716		sqlite_int64 v = sqlite3_value_int64(pIn);
717		pVal = Jim_NewIntObj(p->interp, v);
718		break;
719		}
720		case SQLITE_FLOAT: {
721		double r = sqlite3_value_double(pIn);
722		pVal = Jim_NewDoubleObj(p->interp, r);
723		break;
724		}
725		case SQLITE_NULL: {
726		pVal = Jim_NewStringObj(p->interp, "", 0);
727		break;
728		}
729		default: {
730		int bytes = sqlite3_value_bytes(pIn);
731		pVal = Jim_NewStringObj(p->interp, (char *)sqlite3_value_text(pIn), bytes);
732		break;
733		}
734		}
735		Jim_ListAppendElement(p->interp, pCmd, pVal);
736		}
737		if( !p->useEvalObjv ){
738		/* Jim_EvalOb() will automatically call Jim_EvalObjVector() if pCmd
739		** is a list without a string representation. To prevent this from
740		** happening, make sure pCmd has a valid string representation */
741		Jim_String(pCmd);
742		}
743		rc = Jim_EvalObj(p->interp, pCmd);
744		Jim_DecrRefCount(p->interp, pCmd);
745		}
746
747		if( rc && rc!=JIM_RETURN ){
748		sqlite3_result_error(context, Jim_String(Jim_GetResult(p->interp)), -1);
749		}else{
750		Jim_Obj *pVar = Jim_GetResult(p->interp);
751		int n;
752		u8 *data;
753		/* XXX: Jim Tcl doesn't have bytearray or boolean */
754		const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
755		char c = zType[0];
756		#if 0
757		if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){
758		/* Only return a BLOB type if the Tcl variable is a bytearray and
759		** has no string representation. */
760		data = Jim_GetByteArrayFromObj(pVar, &n);
761		sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT);
762		}else if( c=='b' && strcmp(zType,"boolean")==0 ){
763		Jim_GetWide(0, pVar, &n);
764		sqlite3_result_int(context, n);
765		}else
766		#endif
767		if( c=='d' && strcmp(zType,"double")==0 ){
768		double r;
769		Jim_GetDouble(0, pVar, &r);
770		sqlite3_result_double(context, r);
771		/* XXX: Is a cooerced double better as a double or an int? */
772		}else if( (c=='c' && strcmp(zType,"coerced-double")==0) \|\|
773		(c=='i' && strcmp(zType,"int")==0) ){
774		jim_wide v;
775		Jim_GetWide(p->interp, pVar, &v);
776		sqlite3_result_int64(context, v);
777		}else{
778		data = (unsigned char *)Jim_GetString(pVar, &n);
779		sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT);
780		}
781		}
782		}
783
784		#ifndef SQLITE_OMIT_AUTHORIZATION
785		/*
786		** This is the authentication function. It appends the authentication
787		** type code and the two arguments to zCmd[] then invokes the result
788		** on the interpreter. The reply is examined to determine if the
789		** authentication fails or succeeds.
790		*/
791		static int auth_callback(
792		void *pArg,
793		int code,
794		const char *zArg1,
795		const char *zArg2,
796		const char *zArg3,
797		const char *zArg4
798		){
799		char *zCode;
800		Jim_Obj *str;
801		int rc;
802		const char *zReply;
803		SqliteDb pDb = (SqliteDb)pArg;
804		if( pDb->disableAuth ) return SQLITE_OK;
805
806		switch( code ){
807		case SQLITE_COPY : zCode="SQLITE_COPY"; break;
808		case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break;
809		case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break;
810		case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break;
811		case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break;
812		case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break;
813		case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break;
814		case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break;
815		case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break;
816		case SQLITE_DELETE : zCode="SQLITE_DELETE"; break;
817		case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break;
818		case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break;
819		case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break;
820		case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break;
821		case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break;
822		case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break;
823		case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break;
824		case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break;
825		case SQLITE_INSERT : zCode="SQLITE_INSERT"; break;
826		case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break;
827		case SQLITE_READ : zCode="SQLITE_READ"; break;
828		case SQLITE_SELECT : zCode="SQLITE_SELECT"; break;
829		case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break;
830		case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break;
831		case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break;
832		case SQLITE_DETACH : zCode="SQLITE_DETACH"; break;
833		case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break;
834		case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break;
835		case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break;
836		case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break;
837		case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break;
838		case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break;
839		case SQLITE_SAVEPOINT : zCode="SQLITE_SAVEPOINT"; break;
840		default : zCode="????"; break;
841		}
842		str = Jim_NewStringObj(pDb->interp, pDb->zAuth, -1);
843		/* XXX: list or string here? */
844		Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zCode, -1));
845		if (zArg1) {
846		Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg1, -1));
847		}
848		if (zArg2) {
849		Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg2, -1));
850		}
851		if (zArg3) {
852		Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg3, -1));
853		}
854		if (zArg4) {
855		Jim_ListAppendElement(pDb->interp, str, Jim_NewStringObj(pDb->interp, zArg4, -1));
856		}
857		Jim_IncrRefCount(str);
858		rc = Jim_EvalGlobal(pDb->interp, Jim_String(str));
859		Jim_DecrRefCount(pDb->interp, str);
860		zReply = Jim_String(Jim_GetResult(pDb->interp));
861		if( strcmp(zReply,"SQLITE_OK")==0 ){
862		rc = SQLITE_OK;
863		}else if( strcmp(zReply,"SQLITE_DENY")==0 ){
864		rc = SQLITE_DENY;
865		}else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){
866		rc = SQLITE_IGNORE;
867		}else{
868		rc = 999;
869		}
870		return rc;
871		}
872		#endif /* SQLITE_OMIT_AUTHORIZATION */
873
874		/*
875		** Note that Jim Tcl can't do encoding conversion,
876		** so this simply returns the string as an object.
877		*/
878		static Jim_Obj dbTextToObj(Jim_Interp interp, char const *zText){
879		return Jim_NewStringObj(interp, zText ? zText : "", -1);
880		}
881
882		/*
883		** This routine reads a line of text from FILE in, stores
884		** the text in memory obtained from malloc() and returns a pointer
885		** to the text. NULL is returned at end of file.
886		**
887		** The interface is like "readline" but no command-line editing
888		** is done.
889		**
890		** copied from shell.c from '.import' command
891		*/
892		static char local_getline(char zPrompt, FILE *in){
893		char *zLine;
894		int nLine;
895		int n;
896		int eol;
897
898		nLine = 100;
899		zLine = Jim_Alloc( nLine );
900		n = 0;
901		eol = 0;
902		while( !eol ){
903		if( n+100>nLine ){
904		nLine = nLine*2 + 100;
905		zLine = Jim_Realloc(zLine, nLine);
906		if( zLine==0 ) return 0;
907		}
908		if( fgets(&zLine[n], nLine - n, in)==0 ){
909		if( n==0 ){
910		Jim_Free(zLine);
911		return 0;
912		}
913		zLine[n] = 0;
914		eol = 1;
915		break;
916		}
917		while( zLine[n] ){ n++; }
918		if( n>0 && zLine[n-1]=='\n' ){
919		n--;
920		zLine[n] = 0;
921		eol = 1;
922		}
923		}
924		zLine = Jim_Realloc( zLine, n+1 );
925		return zLine;
926		}
927
928
929		/*
930		** This function is part of the implementation of the command:
931		**
932		** $db transaction [-deferred\|-immediate\|-exclusive] SCRIPT
933		**
934		** It is invoked after evaluating the script SCRIPT to commit or rollback
935		** the transaction or savepoint opened by the [transaction] command.
936		*/
937		static int DbTransPostCmd(
938		Jim_Interp interp, / Tcl interpreter */
939		SqliteDb *pDb,
940		int result /* Result of evaluating SCRIPT */
941		){
942		static const char *azEnd[] = {
943		"RELEASE _tcl_transaction", /* rc==JIM_ERR, nTransaction!=0 */
944		"COMMIT", /* rc!=JIM_ERR, nTransaction==0 */
945		"ROLLBACK TO _tcl_transaction ; RELEASE _tcl_transaction",
946		"ROLLBACK" /* rc==JIM_ERR, nTransaction==0 */
947		};
948		int rc = result;
949		const char *zEnd;
950
951		pDb->nTransaction--;
952		zEnd = azEnd[(rc==JIM_ERR)*2 + (pDb->nTransaction==0)];
953
954		pDb->disableAuth++;
955		if( sqlite3_exec(pDb->db, zEnd, 0, 0, 0) ){
956		/* This is a tricky scenario to handle. The most likely cause of an
957		** error is that the exec() above was an attempt to commit the
958		** top-level transaction that returned SQLITE_BUSY. Or, less likely,
959		** that an IO-error has occured. In either case, throw a Tcl exception
960		** and try to rollback the transaction.
961		**
962		** But it could also be that the user executed one or more BEGIN,
963		** COMMIT, SAVEPOINT, RELEASE or ROLLBACK commands that are confusing
964		** this method's logic. Not clear how this would be best handled.
965		*/
966		if( rc!=JIM_ERR ){
967		Jim_AppendString(interp, Jim_GetResult(interp), sqlite3_errmsg(pDb->db), -1);
968		rc = JIM_ERR;
969		}
970		sqlite3_exec(pDb->db, "ROLLBACK", 0, 0, 0);
971		}
972		pDb->disableAuth--;
973
974		return rc;
975		}
976
977		/*
978		** Search the cache for a prepared-statement object that implements the
979		** first SQL statement in the buffer pointed to by parameter zIn. If
980		** no such prepared-statement can be found, allocate and prepare a new
981		** one. In either case, bind the current values of the relevant Tcl
982		** variables to any $var, :var or @var variables in the statement. Before
983		** returning, set *ppPreStmt to point to the prepared-statement object.
984		**
985		** Output parameter *pzOut is set to point to the next SQL statement in
986		** buffer zIn, or to the '\0' byte at the end of zIn if there is no
987		** next statement.
988		**
989		** If successful, JIM_OK is returned. Otherwise, JIM_ERR is returned
990		** and an error message loaded into interpreter pDb->interp.
991		*/
992		static int dbPrepareAndBind(
993		SqliteDb pDb, / Database object */
994		char const zIn, / SQL to compile */
995		char const *pzOut, / OUT: Pointer to next SQL statement */
996		SqlPreparedStmt *ppPreStmt / OUT: Object used to cache statement */
997		){
998		const char zSql = zIn; / Pointer to first SQL statement in zIn */
999		sqlite3_stmt pStmt; / Prepared statement object */
1000		SqlPreparedStmt pPreStmt; / Pointer to cached statement */
1001		int nSql; /* Length of zSql in bytes */
1002		int nVar; /* Number of variables in statement */
1003		int iParm = 0; /* Next free entry in apParm */
1004		int i;
1005		Jim_Interp *interp = pDb->interp;
1006
1007		*ppPreStmt = 0;
1008
1009		/* Trim spaces from the start of zSql and calculate the remaining length. */
1010		while( isspace((unsigned)zSql[0]) ){ zSql++; }
1011		nSql = strlen30(zSql);
1012
1013		for(pPreStmt = pDb->stmtList; pPreStmt; pPreStmt=pPreStmt->pNext){
1014		int n = pPreStmt->nSql;
1015		if( nSql>=n
1016		&& memcmp(pPreStmt->zSql, zSql, n)==0
1017		&& (zSql[n]==0 \|\| zSql[n-1]==';')
1018		){
1019		pStmt = pPreStmt->pStmt;
1020		*pzOut = &zSql[pPreStmt->nSql];
1021
1022		/* When a prepared statement is found, unlink it from the
1023		** cache list. It will later be added back to the beginning
1024		** of the cache list in order to implement LRU replacement.
1025		*/
1026		if( pPreStmt->pPrev ){
1027		pPreStmt->pPrev->pNext = pPreStmt->pNext;
1028		}else{
1029		pDb->stmtList = pPreStmt->pNext;
1030		}
1031		if( pPreStmt->pNext ){
1032		pPreStmt->pNext->pPrev = pPreStmt->pPrev;
1033		}else{
1034		pDb->stmtLast = pPreStmt->pPrev;
1035		}
1036		pDb->nStmt--;
1037		nVar = sqlite3_bind_parameter_count(pStmt);
1038		break;
1039		}
1040		}
1041
1042		/* If no prepared statement was found. Compile the SQL text. Also allocate
1043		** a new SqlPreparedStmt structure. */
1044		if( pPreStmt==0 ){
1045		int nByte;
1046
1047		if( SQLITE_OK!=sqlite3_prepare_v2(pDb->db, zSql, -1, &pStmt, pzOut) ){
1048		Jim_SetResult(interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db)));
1049		return JIM_ERR;
1050		}
1051		if( pStmt==0 ){
1052		if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){
1053		/* A compile-time error in the statement. */
1054		Jim_SetResult(interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db)));
1055		return JIM_ERR;
1056		}else{
1057		/* The statement was a no-op. Continue to the next statement
1058		** in the SQL string.
1059		*/
1060		return JIM_OK;
1061		}
1062		}
1063
1064		assert( pPreStmt==0 );
1065		nVar = sqlite3_bind_parameter_count(pStmt);
1066		nByte = sizeof(SqlPreparedStmt) + nVarsizeof(Jim_Obj );
1067		pPreStmt = (SqlPreparedStmt*)Jim_Alloc(nByte);
1068		memset(pPreStmt, 0, nByte);
1069
1070		pPreStmt->pStmt = pStmt;
1071		pPreStmt->nSql = (*pzOut - zSql);
1072		pPreStmt->zSql = sqlite3_sql(pStmt);
1073		pPreStmt->apParm = (Jim_Obj **)&pPreStmt[1];
1074		}
1075		assert( pPreStmt );
1076		assert( strlen30(pPreStmt->zSql)==pPreStmt->nSql );
1077		assert( 0==memcmp(pPreStmt->zSql, zSql, pPreStmt->nSql) );
1078
1079		/* Bind values to parameters that begin with $ or : */
1080		for(i=1; i<=nVar; i++){
1081		const char *zVar = sqlite3_bind_parameter_name(pStmt, i);
1082		if( zVar!=0 && (zVar[0]=='$' \|\| zVar[0]==':' \|\| zVar[0]=='@') ){
1083		Jim_Obj *pVar = Jim_GetVariableStr(interp, &zVar[1], 0);
1084		if( pVar ){
1085		int n;
1086		u8 *data;
1087		const char *zType = (pVar->typePtr ? pVar->typePtr->name : "");
1088		char c = zType[0];
1089		/* XXX: Jim Tcl doesn't have bytearray or boolean */
1090		if( zVar[0]=='@') {
1091		#if 0
1092		\|\|
1093		(c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0) ){
1094		/* Load a BLOB type if the Tcl variable is a bytearray and
1095		** it has no string representation or the host
1096		** parameter name begins with "@". */
1097		data = Jim_GetByteArrayFromObj(pVar, &n);
1098		#else
1099		data = (unsigned char *)Jim_GetString(pVar, &n);
1100		#endif
1101		sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC);
1102		Jim_IncrRefCount(pVar);
1103		pPreStmt->apParm[iParm++] = pVar;
1104		#if 0
1105		}else if( c=='b' && strcmp(zType,"boolean")==0 ){
1106		Jim_GetWide(interp, pVar, &n);
1107		sqlite3_bind_int(pStmt, i, n);
1108		#endif
1109		}else if( c=='d' && strcmp(zType,"double")==0 ){
1110		double r;
1111		Jim_GetDouble(interp, pVar, &r);
1112		sqlite3_bind_double(pStmt, i, r);
1113		}else if( (c=='c' && strcmp(zType,"coerced-double")==0) \|\|
1114		(c=='i' && strcmp(zType,"int")==0) ){
1115		jim_wide v;
1116		Jim_GetWide(interp, pVar, &v);
1117		sqlite3_bind_int64(pStmt, i, v);
1118		}else{
1119		data = (unsigned char *)Jim_GetString(pVar, &n);
1120		sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC);
1121		Jim_IncrRefCount(pVar);
1122		pPreStmt->apParm[iParm++] = pVar;
1123		}
1124		}else{
1125		sqlite3_bind_null(pStmt, i);
1126		}
1127		}
1128		}
1129		pPreStmt->nParm = iParm;
1130		*ppPreStmt = pPreStmt;
1131
1132		return JIM_OK;
1133		}
1134
1135
1136		/*
1137		** Release a statement reference obtained by calling dbPrepareAndBind().
1138		** There should be exactly one call to this function for each call to
1139		** dbPrepareAndBind().
1140		**
1141		** If the discard parameter is non-zero, then the statement is deleted
1142		** immediately. Otherwise it is added to the LRU list and may be returned
1143		** by a subsequent call to dbPrepareAndBind().
1144		*/
1145		static void dbReleaseStmt(
1146		SqliteDb pDb, / Database handle */
1147		SqlPreparedStmt pPreStmt, / Prepared statement handle to release */
1148		int discard /* True to delete (not cache) the pPreStmt */
1149		){
1150		int i;
1151
1152		/* Free the bound string and blob parameters */
1153		for(i=0; i<pPreStmt->nParm; i++){
1154		Jim_DecrRefCount(pDb->interp, pPreStmt->apParm[i]);
1155		}
1156		pPreStmt->nParm = 0;
1157
1158		if( pDb->maxStmt<=0 \|\| discard ){
1159		/* If the cache is turned off, deallocated the statement */
1160		sqlite3_finalize(pPreStmt->pStmt);
1161		Jim_Free((char *)pPreStmt);
1162		}else{
1163		/* Add the prepared statement to the beginning of the cache list. */
1164		pPreStmt->pNext = pDb->stmtList;
1165		pPreStmt->pPrev = 0;
1166		if( pDb->stmtList ){
1167		pDb->stmtList->pPrev = pPreStmt;
1168		}
1169		pDb->stmtList = pPreStmt;
1170		if( pDb->stmtLast==0 ){
1171		assert( pDb->nStmt==0 );
1172		pDb->stmtLast = pPreStmt;
1173		}else{
1174		assert( pDb->nStmt>0 );
1175		}
1176		pDb->nStmt++;
1177
1178		/* If we have too many statement in cache, remove the surplus from
1179		** the end of the cache list. */
1180		while( pDb->nStmt>pDb->maxStmt ){
1181		sqlite3_finalize(pDb->stmtLast->pStmt);
1182		pDb->stmtLast = pDb->stmtLast->pPrev;
1183		Jim_Free((char*)pDb->stmtLast->pNext);
1184		pDb->stmtLast->pNext = 0;
1185		pDb->nStmt--;
1186		}
1187		}
1188		}
1189
1190		/*
1191		** Structure used with dbEvalXXX() functions:
1192		**
1193		** dbEvalInit()
1194		** dbEvalStep()
1195		** dbEvalFinalize()
1196		** dbEvalRowInfo()
1197		** dbEvalColumnValue()
1198		*/
1199		typedef struct DbEvalContext DbEvalContext;
1200		struct DbEvalContext {
1201		SqliteDb pDb; / Database handle */
1202		Jim_Obj pSql; / Object holding string zSql */
1203		const char zSql; / Remaining SQL to execute */
1204		SqlPreparedStmt pPreStmt; / Current statement */
1205		int nCol; /* Number of columns returned by pStmt */
1206		Jim_Obj pArray; / Name of array variable */
1207		Jim_Obj *apColName; / Array of column names */
1208		};
1209
1210		/*
1211		** Release any cache of column names currently held as part of
1212		** the DbEvalContext structure passed as the first argument.
1213		*/
1214		static void dbReleaseColumnNames(DbEvalContext *p){
1215		if( p->apColName ){
1216		int i;
1217		for(i=0; i<p->nCol; i++){
1218		Jim_DecrRefCount(p->pDb->interp, p->apColName[i]);
1219		}
1220		Jim_Free((char *)p->apColName);
1221		p->apColName = 0;
1222		}
1223		p->nCol = 0;
1224		}
1225
1226		/*
1227		** Initialize a DbEvalContext structure.
1228		**
1229		** If pArray is not NULL, then it contains the name of a Tcl array
1230		** variable. The "*" member of this array is set to a list containing
1231		** the names of the columns returned by the statement as part of each
1232		** call to dbEvalStep(), in order from left to right. e.g. if the names
1233		** of the returned columns are a, b and c, it does the equivalent of the
1234		** tcl command:
1235		**
1236		** set ${pArray}(*) {a b c}
1237		*/
1238		static void dbEvalInit(
1239		DbEvalContext p, / Pointer to structure to initialize */
1240		SqliteDb pDb, / Database handle */
1241		Jim_Obj pSql, / Object containing SQL script */
1242		Jim_Obj pArray / Name of Tcl array to set () element of /
1243		){
1244		memset(p, 0, sizeof(DbEvalContext));
1245		p->pDb = pDb;
1246		p->zSql = Jim_String(pSql);
1247		p->pSql = pSql;
1248		Jim_IncrRefCount(pSql);
1249		if( pArray ){
1250		p->pArray = pArray;
1251		Jim_IncrRefCount(pArray);
1252		}
1253		}
1254
1255		/*
1256		** Obtain information about the row that the DbEvalContext passed as the
1257		** first argument currently points to.
1258		*/
1259		static void dbEvalRowInfo(
1260		DbEvalContext p, / Evaluation context */
1261		int pnCol, / OUT: Number of column names */
1262		Jim_Obj **papColName / OUT: Array of column names */
1263		){
1264		/* Compute column names */
1265		if( 0==p->apColName ){
1266		sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
1267		int i; /* Iterator variable */
1268		int nCol; /* Number of columns returned by pStmt */
1269		Jim_Obj *apColName = 0; / Array of column names */
1270
1271		p->nCol = nCol = sqlite3_column_count(pStmt);
1272		if( nCol>0 && (papColName \|\| p->pArray) ){
1273		apColName = (Jim_Obj*)Jim_Alloc( sizeof(Jim_Obj)*nCol );
1274		for(i=0; i<nCol; i++){
1275		apColName[i] = dbTextToObj(p->pDb->interp, sqlite3_column_name(pStmt,i));
1276		Jim_IncrRefCount(apColName[i]);
1277		}
1278		p->apColName = apColName;
1279		}
1280
1281		/* If results are being stored in an array variable, then create
1282		** the array(*) entry for that array
1283		*/
1284		if( p->pArray ){
1285		Jim_Interp *interp = p->pDb->interp;
1286		Jim_Obj *pColList = Jim_NewListObj(interp, apColName, nCol);
1287		Jim_Obj pStar = Jim_NewStringObj(interp, "", -1);
1288		Jim_IncrRefCount(pStar);
1289		Jim_SetDictKeysVector(interp, p->pArray, &pStar, 1, pColList, 0);
1290		Jim_DecrRefCount(interp, pStar);
1291		}
1292		}
1293
1294		if( papColName ){
1295		*papColName = p->apColName;
1296		}
1297		if( pnCol ){
1298		*pnCol = p->nCol;
1299		}
1300		}
1301
1302		/*
1303		** Return one of JIM_OK, JIM_BREAK or JIM_ERR. If JIM_ERR is
1304		** returned, then an error message is stored in the interpreter before
1305		** returning.
1306		**
1307		** A return value of JIM_OK means there is a row of data available. The
1308		** data may be accessed using dbEvalRowInfo() and dbEvalColumnValue(). This
1309		** is analogous to a return of SQLITE_ROW from sqlite3_step(). If JIM_BREAK
1310		** is returned, then the SQL script has finished executing and there are
1311		** no further rows available. This is similar to SQLITE_DONE.
1312		*/
1313		static int dbEvalStep(DbEvalContext *p){
1314		while( p->zSql[0] \|\| p->pPreStmt ){
1315		int rc;
1316		if( p->pPreStmt==0 ){
1317		rc = dbPrepareAndBind(p->pDb, p->zSql, &p->zSql, &p->pPreStmt);
1318		if( rc!=JIM_OK ) return rc;
1319		}else{
1320		int rcs;
1321		SqliteDb *pDb = p->pDb;
1322		SqlPreparedStmt *pPreStmt = p->pPreStmt;
1323		sqlite3_stmt *pStmt = pPreStmt->pStmt;
1324
1325		rcs = sqlite3_step(pStmt);
1326		if( rcs==SQLITE_ROW ){
1327		return JIM_OK;
1328		}
1329		if( p->pArray ){
1330		dbEvalRowInfo(p, 0, 0);
1331		}
1332		rcs = sqlite3_reset(pStmt);
1333
1334		pDb->nStep = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_FULLSCAN_STEP,1);
1335		pDb->nSort = sqlite3_stmt_status(pStmt,SQLITE_STMTSTATUS_SORT,1);
1336		dbReleaseColumnNames(p);
1337		p->pPreStmt = 0;
1338
1339		if( rcs!=SQLITE_OK ){
1340		/* If a run-time error occurs, report the error and stop reading
1341		** the SQL. */
1342		Jim_SetResult(pDb->interp, dbTextToObj(pDb->interp, sqlite3_errmsg(pDb->db)));
1343		dbReleaseStmt(pDb, pPreStmt, 1);
1344		return JIM_ERR;
1345		}else{
1346		dbReleaseStmt(pDb, pPreStmt, 0);
1347		}
1348		}
1349		}
1350
1351		/* Finished */
1352		return JIM_BREAK;
1353		}
1354
1355		/*
1356		** Free all resources currently held by the DbEvalContext structure passed
1357		** as the first argument. There should be exactly one call to this function
1358		** for each call to dbEvalInit().
1359		*/
1360		static void dbEvalFinalize(DbEvalContext *p){
1361		if( p->pPreStmt ){
1362		sqlite3_reset(p->pPreStmt->pStmt);
1363		dbReleaseStmt(p->pDb, p->pPreStmt, 0);
1364		p->pPreStmt = 0;
1365		}
1366		if( p->pArray ){
1367		Jim_DecrRefCount(p->pDb->interp, p->pArray);
1368		p->pArray = 0;
1369		}
1370		Jim_DecrRefCount(p->pDb->interp, p->pSql);
1371		dbReleaseColumnNames(p);
1372		}
1373
1374		/*
1375		** Return a pointer to a Jim_Obj structure with ref-count 0 that contains
1376		** the value for the iCol'th column of the row currently pointed to by
1377		** the DbEvalContext structure passed as the first argument.
1378		*/
1379		static Jim_Obj dbEvalColumnValue(DbEvalContext p, int iCol){
1380		sqlite3_stmt *pStmt = p->pPreStmt->pStmt;
1381		switch( sqlite3_column_type(pStmt, iCol) ){
1382		case SQLITE_BLOB: {
1383		int bytes = sqlite3_column_bytes(pStmt, iCol);
1384		const char *zBlob = sqlite3_column_blob(pStmt, iCol);
1385		if( !zBlob ) bytes = 0;
1386		//return Jim_NewByteArrayObj((u8*)zBlob, bytes);
1387		return Jim_NewStringObj(p->pDb->interp, zBlob, bytes);
1388		}
1389		case SQLITE_INTEGER: {
1390		sqlite_int64 v = sqlite3_column_int64(pStmt, iCol);
1391		return Jim_NewIntObj(p->pDb->interp, v);
1392		}
1393		case SQLITE_FLOAT: {
1394		return Jim_NewDoubleObj(p->pDb->interp, sqlite3_column_double(pStmt, iCol));
1395		}
1396		case SQLITE_NULL: {
1397		return dbTextToObj(p->pDb->interp, p->pDb->zNull);
1398		}
1399		}
1400
1401		return dbTextToObj(p->pDb->interp, (char *)sqlite3_column_text(pStmt, iCol));
1402		}
1403
1404		static int Jim_ObjSetVar2(Jim_Interp interp, Jim_Obj nameObjPtr, Jim_Obj keyObjPtr, Jim_Obj valObjPtr)
1405		{
1406		return Jim_SetDictKeysVector(interp, nameObjPtr, &keyObjPtr, 1, valObjPtr, 0);
1407		}
1408
1409		/*
1410		** This function is part of the implementation of the command:
1411		**
1412		** $db eval SQL ?ARRAYNAME? SCRIPT
1413		*/
1414		static int DbEvalNextCmd(
1415		Jim_Interp interp, / Tcl interpreter */
1416		DbEvalContext *p,
1417		Jim_Obj *pScript,
1418		int result /* Result so far */
1419		){
1420		int rc = result; /* Return code */
1421
1422		Jim_Obj *pArray = p->pArray;
1423
1424		while( (rc==JIM_OK \|\| rc==JIM_CONTINUE) && JIM_OK==(rc = dbEvalStep(p)) ){
1425		int i;
1426		int nCol;
1427		Jim_Obj **apColName;
1428		dbEvalRowInfo(p, &nCol, &apColName);
1429		for(i=0; i<nCol; i++){
1430		Jim_Obj *pVal = dbEvalColumnValue(p, i);
1431		if( pArray==0 ){
1432		Jim_SetVariable(interp, apColName[i], pVal);
1433		}else{
1434		Jim_ObjSetVar2(interp, pArray, apColName[i], pVal);
1435		}
1436		}
1437
1438		/* The required interpreter variables are now populated with the data
1439		** from the current row.
1440		**
1441		** No NRE in Jim Tcl, so evaluate pScript directly and continue with the
1442		** next iteration of this while(...) loop. */
1443		rc = Jim_EvalObj(interp, pScript);
1444		}
1445
1446		Jim_DecrRefCount(interp, pScript);
1447		dbEvalFinalize(p);
1448		Jim_Free((char *)p);
1449
1450		if( rc==JIM_OK \|\| rc==JIM_BREAK ){
1451		Jim_SetEmptyResult(interp);
1452		rc = JIM_OK;
1453		}
1454		return rc;
1455		}
1456
1457		/*
1458		** The "sqlite" command below creates a new Tcl command for each
1459		** connection it opens to an SQLite database. This routine is invoked
1460		** whenever one of those connection-specific commands is executed
1461		** in Tcl. For example, if you run Tcl code like this:
1462		**
1463		** sqlite3 db1 "my_database"
1464		** db1 close
1465		**
1466		** The first command opens a connection to the "my_database" database
1467		** and calls that connection "db1". The second command causes this
1468		** subroutine to be invoked.
1469		*/
1470		static int DbObjCmd(Jim_Interp interp, int objc,Jim_Obj const*objv){
1471		SqliteDb pDb = (SqliteDb)Jim_CmdPrivData(interp);
1472		int choice;
1473		int rc = JIM_OK;
1474		static const char *DB_strs[] = {
1475		"authorizer", "backup", "busy",
1476		"cache", "changes", "close",
1477		"collate", "collation_needed", "commit_hook",
1478		"complete", "copy", "enable_load_extension",
1479		"errorcode", "eval", "exists",
1480		"function", "incrblob", "interrupt",
1481		"last_insert_rowid", "nullvalue", "onecolumn",
1482		"profile", "progress", "rekey",
1483		"restore", "rollback_hook", "status",
1484		"timeout", "total_changes", "trace",
1485		"transaction", "unlock_notify", "update_hook",
1486		"version", 0
1487		};
1488		enum DB_enum {
1489		DB_AUTHORIZER, DB_BACKUP, DB_BUSY,
1490		DB_CACHE, DB_CHANGES, DB_CLOSE,
1491		DB_COLLATE, DB_COLLATION_NEEDED, DB_COMMIT_HOOK,
1492		DB_COMPLETE, DB_COPY, DB_ENABLE_LOAD_EXTENSION,
1493		DB_ERRORCODE, DB_EVAL, DB_EXISTS,
1494		DB_FUNCTION, DB_INCRBLOB, DB_INTERRUPT,
1495		DB_LAST_INSERT_ROWID, DB_NULLVALUE, DB_ONECOLUMN,
1496		DB_PROFILE, DB_PROGRESS, DB_REKEY,
1497		DB_RESTORE, DB_ROLLBACK_HOOK, DB_STATUS,
1498		DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE,
1499		DB_TRANSACTION, DB_UNLOCK_NOTIFY, DB_UPDATE_HOOK,
1500		DB_VERSION,
1501		};
1502		/* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */
1503
1504		if( objc<2 ){
1505		Jim_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
1506		return JIM_ERR;
1507		}
1508		if( Jim_GetEnum(interp, objv[1], DB_strs, &choice, "option", JIM_ERRMSG \| JIM_ENUM_ABBREV) ){
1509		return JIM_ERR;
1510		}
1511
1512		switch( (enum DB_enum)choice ){
1513
1514		/* $db authorizer ?CALLBACK?
1515		**
1516		** Invoke the given callback to authorize each SQL operation as it is
1517		** compiled. 5 arguments are appended to the callback before it is
1518		** invoked:
1519		**
1520		** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
1521		** (2) First descriptive name (depends on authorization type)
1522		** (3) Second descriptive name
1523		** (4) Name of the database (ex: "main", "temp")
1524		** (5) Name of trigger that is doing the access
1525		**
1526		** The callback should return on of the following strings: SQLITE_OK,
1527		** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
1528		**
1529		** If this method is invoked with no arguments, the current authorization
1530		** callback string is returned.
1531		*/
1532		case DB_AUTHORIZER: {
1533		#ifdef SQLITE_OMIT_AUTHORIZATION
1534		Jim_SetResultString(interp, "authorization not available in this build", -1);
1535		return JIM_ERR;
1536		#else
1537		if( objc>3 ){
1538		Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
1539		return JIM_ERR;
1540		}else if( objc==2 ){
1541		if( pDb->zAuth ){
1542		Jim_SetResultString(interp, pDb->zAuth, -1);
1543		}
1544		}else{
1545		const char *zAuth;
1546		int len;
1547		if( pDb->zAuth ){
1548		Jim_Free(pDb->zAuth);
1549		}
1550		zAuth = Jim_GetString(objv[2], &len);
1551		if( zAuth && len>0 ){
1552		pDb->zAuth = Jim_Alloc( len + 1 );
1553		memcpy(pDb->zAuth, zAuth, len+1);
1554		}else{
1555		pDb->zAuth = 0;
1556		}
1557		if( pDb->zAuth ){
1558		pDb->interp = interp;
1559		sqlite3_set_authorizer(pDb->db, auth_callback, pDb);
1560		}else{
1561		sqlite3_set_authorizer(pDb->db, 0, 0);
1562		}
1563		}
1564		#endif
1565		break;
1566		}
1567
1568		/* $db backup ?DATABASE? FILENAME
1569		**
1570		** Open or create a database file named FILENAME. Transfer the
1571		** content of local database DATABASE (default: "main") into the
1572		** FILENAME database.
1573		*/
1574		case DB_BACKUP: {
1575		const char *zDestFile;
1576		const char *zSrcDb;
1577		sqlite3 *pDest;
1578		sqlite3_backup *pBackup;
1579
1580		if( objc==3 ){
1581		zSrcDb = "main";
1582		zDestFile = Jim_String(objv[2]);
1583		}else if( objc==4 ){
1584		zSrcDb = Jim_String(objv[2]);
1585		zDestFile = Jim_String(objv[3]);
1586		}else{
1587		Jim_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
1588		return JIM_ERR;
1589		}
1590		rc = sqlite3_open(zDestFile, &pDest);
1591		if( rc!=SQLITE_OK ){
1592		Jim_SetResultFormatted(interp, "cannot open target database: %s", sqlite3_errmsg(pDest));
1593		sqlite3_close(pDest);
1594		return JIM_ERR;
1595		}
1596		pBackup = sqlite3_backup_init(pDest, "main", pDb->db, zSrcDb);
1597		if( pBackup==0 ){
1598		Jim_SetResultFormatted(interp, "backup failed: %s", sqlite3_errmsg(pDest));
1599		sqlite3_close(pDest);
1600		return JIM_ERR;
1601		}
1602		while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK ){}
1603		sqlite3_backup_finish(pBackup);
1604		if( rc==SQLITE_DONE ){
1605		rc = JIM_OK;
1606		}else{
1607		Jim_SetResultFormatted(interp, "backup failed: %s", sqlite3_errmsg(pDest));
1608		rc = JIM_ERR;
1609		}
1610		sqlite3_close(pDest);
1611		break;
1612		}
1613
1614		/* $db busy ?CALLBACK?
1615		**
1616		** Invoke the given callback if an SQL statement attempts to open
1617		** a locked database file.
1618		*/
1619		case DB_BUSY: {
1620		if( objc>3 ){
1621		Jim_WrongNumArgs(interp, 2, objv, "CALLBACK");
1622		return JIM_ERR;
1623		}else if( objc==2 ){
1624		if( pDb->zBusy ){
1625		Jim_SetResultString(interp, pDb->zBusy, -1);
1626		}
1627		}else{
1628		const char *zBusy;
1629		int len;
1630		if( pDb->zBusy ){
1631		Jim_Free(pDb->zBusy);
1632		}
1633		zBusy = Jim_GetString(objv[2], &len);
1634		if( zBusy && len>0 ){
1635		pDb->zBusy = Jim_Alloc( len + 1 );
1636		memcpy(pDb->zBusy, zBusy, len+1);
1637		}else{
1638		pDb->zBusy = 0;
1639		}
1640		if( pDb->zBusy ){
1641		pDb->interp = interp;
1642		sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb);
1643		}else{
1644		sqlite3_busy_handler(pDb->db, 0, 0);
1645		}
1646		}
1647		break;
1648		}
1649
1650		/* $db cache flush
1651		** $db cache size n
1652		**
1653		** Flush the prepared statement cache, or set the maximum number of
1654		** cached statements.
1655		*/
1656		case DB_CACHE: {
1657		const char *subCmd;
1658
1659		if( objc<=2 ){
1660		Jim_WrongNumArgs(interp, 1, objv, "cache option ?arg?");
1661		return JIM_ERR;
1662		}
1663		subCmd = Jim_String( objv[2]);
1664		if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){
1665		if( objc!=3 ){
1666		Jim_WrongNumArgs(interp, 2, objv, "flush");
1667		return JIM_ERR;
1668		}else{
1669		flushStmtCache( pDb );
1670		}
1671		}else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){
1672		if( objc!=4 ){
1673		Jim_WrongNumArgs(interp, 2, objv, "size n");
1674		return JIM_ERR;
1675		}else{
1676		jim_wide w;
1677		if( JIM_ERR==Jim_GetWide(interp, objv[3], &w) ){
1678		return JIM_ERR;
1679		}else{
1680		if( w<0 ){
1681		flushStmtCache( pDb );
1682		w = 0;
1683		}else if( w>MAX_PREPARED_STMTS ){
1684		w = MAX_PREPARED_STMTS;
1685		}
1686		pDb->maxStmt = w;
1687		}
1688		}
1689		}else{
1690		Jim_SetResultFormatted(interp, "bad option \"%#s\": must be flush or size", objv[2]);
1691		return JIM_ERR;
1692		}
1693		break;
1694		}
1695
1696		/* $db changes
1697		**
1698		** Return the number of rows that were modified, inserted, or deleted by
1699		** the most recent INSERT, UPDATE or DELETE statement, not including
1700		** any changes made by trigger programs.
1701		*/
1702		case DB_CHANGES: {
1703		if( objc!=2 ){
1704		Jim_WrongNumArgs(interp, 2, objv, "");
1705		return JIM_ERR;
1706		}
1707		Jim_SetResultInt(interp, sqlite3_changes(pDb->db));
1708		break;
1709		}
1710
1711		/* $db close
1712		**
1713		** Shutdown the database
1714		*/
1715		case DB_CLOSE: {
1716		Jim_DeleteCommand(interp, Jim_String(objv[0]));
1717		break;
1718		}
1719
1720		/*
1721		** $db collate NAME SCRIPT
1722		**
1723		** Create a new SQL collation function called NAME. Whenever
1724		** that function is called, invoke SCRIPT to evaluate the function.
1725		*/
1726		case DB_COLLATE: {
1727		SqlCollate *pCollate;
1728		const char *zName;
1729		const char *zScript;
1730		int nScript;
1731		if( objc!=4 ){
1732		Jim_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
1733		return JIM_ERR;
1734		}
1735		zName = Jim_String(objv[2]);
1736		zScript = Jim_GetString(objv[3], &nScript);
1737		pCollate = (SqlCollate)Jim_Alloc( sizeof(pCollate) + nScript + 1 );
1738		if( pCollate==0 ) return JIM_ERR;
1739		pCollate->interp = interp;
1740		pCollate->pNext = pDb->pCollate;
1741		pCollate->zScript = (char*)&pCollate[1];
1742		pDb->pCollate = pCollate;
1743		memcpy(pCollate->zScript, zScript, nScript+1);
1744		if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8,
1745		pCollate, tclSqlCollate) ){
1746		Jim_SetResultString(interp, (char *)sqlite3_errmsg(pDb->db), -1);
1747		return JIM_ERR;
1748		}
1749		break;
1750		}
1751
1752		/*
1753		** $db collation_needed SCRIPT
1754		**
1755		** Create a new SQL collation function called NAME. Whenever
1756		** that function is called, invoke SCRIPT to evaluate the function.
1757		*/
1758		case DB_COLLATION_NEEDED: {
1759		if( objc!=3 ){
1760		Jim_WrongNumArgs(interp, 2, objv, "SCRIPT");
1761		return JIM_ERR;
1762		}
1763		if( pDb->pCollateNeeded ){
1764		Jim_DecrRefCount(interp, pDb->pCollateNeeded);
1765		}
1766		pDb->pCollateNeeded = Jim_DuplicateObj(pDb->interp, objv[2]);
1767		Jim_IncrRefCount(pDb->pCollateNeeded);
1768		sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
1769		break;
1770		}
1771
1772		/* $db commit_hook ?CALLBACK?
1773		**
1774		** Invoke the given callback just before committing every SQL transaction.
1775		** If the callback throws an exception or returns non-zero, then the
1776		** transaction is aborted. If CALLBACK is an empty string, the callback
1777		** is disabled.
1778		*/
1779		case DB_COMMIT_HOOK: {
1780		if( objc>3 ){
1781		Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
1782		return JIM_ERR;
1783		}else if( objc==2 ){
1784		if( pDb->zCommit ){
1785		Jim_SetResultString(interp, pDb->zCommit, -1);
1786		}
1787		}else{
1788		const char *zCommit;
1789		int len;
1790		if( pDb->zCommit ){
1791		Jim_Free(pDb->zCommit);
1792		}
1793		zCommit = Jim_GetString(objv[2], &len);
1794		if( zCommit && len>0 ){
1795		pDb->zCommit = Jim_Alloc( len + 1 );
1796		memcpy(pDb->zCommit, zCommit, len+1);
1797		}else{
1798		pDb->zCommit = 0;
1799		}
1800		if( pDb->zCommit ){
1801		pDb->interp = interp;
1802		sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
1803		}else{
1804		sqlite3_commit_hook(pDb->db, 0, 0);
1805		}
1806		}
1807		break;
1808		}
1809
1810		/* $db complete SQL
1811		**
1812		** Return TRUE if SQL is a complete SQL statement. Return FALSE if
1813		** additional lines of input are needed. This is similar to the
1814		** built-in "info complete" command of Tcl.
1815		*/
1816		case DB_COMPLETE: {
1817		#ifndef SQLITE_OMIT_COMPLETE
1818		if( objc!=3 ){
1819		Jim_WrongNumArgs(interp, 2, objv, "SQL");
1820		return JIM_ERR;
1821		}
1822		Jim_SetResultInt(interp, sqlite3_complete( Jim_String(objv[2]) ));
1823		#endif
1824		break;
1825		}
1826
1827		/* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR?
1828		**
1829		** Copy data into table from filename, optionally using SEPARATOR
1830		** as column separators. If a column contains a null string, or the
1831		** value of NULLINDICATOR, a NULL is inserted for the column.
1832		** conflict-algorithm is one of the sqlite conflict algorithms:
1833		** rollback, abort, fail, ignore, replace
1834		** On success, return the number of lines processed, not necessarily same
1835		** as 'db changes' due to conflict-algorithm selected.
1836		**
1837		** This code is basically an implementation/enhancement of
1838		** the sqlite3 shell.c ".import" command.
1839		**
1840		** This command usage is equivalent to the sqlite2.x COPY statement,
1841		** which imports file data into a table using the PostgreSQL COPY file format:
1842		** $db copy $conflit_algo $table_name $filename \t \\N
1843		*/
1844		case DB_COPY: {
1845		const char zTable; / Insert data into this table */
1846		const char zFile; / The file from which to extract data */
1847		const char zConflict; / The conflict algorithm to use */
1848		sqlite3_stmt pStmt; / A statement */
1849		int nCol; /* Number of columns in the table */
1850		int nByte; /* Number of bytes in an SQL string */
1851		int i, j; /* Loop counters */
1852		int nSep; /* Number of bytes in zSep[] */
1853		int nNull; /* Number of bytes in zNull[] */
1854		char zSql; / An SQL statement */
1855		char zLine; / A single line of input from the file */
1856		char *azCol; / zLine[] broken up into columns */
1857		char zCommit; / How to commit changes */
1858		FILE in; / The input file */
1859		int lineno = 0; /* Line number of input file */
1860		char zLineNum[80]; /* Line number print buffer */
1861
1862		const char *zSep;
1863		const char *zNull;
1864		if( objc<5 \|\| objc>7 ){
1865		Jim_WrongNumArgs(interp, 2, objv,
1866		"CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?");
1867		return JIM_ERR;
1868		}
1869		if( objc>=6 ){
1870		zSep = Jim_String(objv[5]);
1871		}else{
1872		zSep = "\t";
1873		}
1874		if( objc>=7 ){
1875		zNull = Jim_String(objv[6]);
1876		}else{
1877		zNull = "";
1878		}
1879		zConflict = Jim_String(objv[2]);
1880		zTable = Jim_String(objv[3]);
1881		zFile = Jim_String(objv[4]);
1882		nSep = strlen30(zSep);
1883		nNull = strlen30(zNull);
1884		if( nSep==0 ){
1885		Jim_SetResultString(interp, "Error: non-null separator required for copy", -1);
1886		return JIM_ERR;
1887		}
1888		if(strcmp(zConflict, "rollback") != 0 &&
1889		strcmp(zConflict, "abort" ) != 0 &&
1890		strcmp(zConflict, "fail" ) != 0 &&
1891		strcmp(zConflict, "ignore" ) != 0 &&
1892		strcmp(zConflict, "replace" ) != 0 ) {
1893		Jim_SetResultFormatted(interp, "Error: \"%s\", conflict-algorithm must be one of: rollback, "
1894		"abort, fail, ignore, or replace", zConflict);
1895		return JIM_ERR;
1896		}
1897		zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable);
1898		if( zSql==0 ){
1899		Jim_SetResultFormatted(interp, "Error: no such table: %s", zTable);
1900		return JIM_ERR;
1901		}
1902		nByte = strlen30(zSql);
1903		rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
1904		sqlite3_free(zSql);
1905		if( rc ){
1906		Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db));
1907		nCol = 0;
1908		}else{
1909		nCol = sqlite3_column_count(pStmt);
1910		}
1911		sqlite3_finalize(pStmt);
1912		if( nCol==0 ) {
1913		return JIM_ERR;
1914		}
1915		zSql = Jim_Alloc( nByte + 50 + nCol*2 );
1916		sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?",
1917		zConflict, zTable);
1918		j = strlen30(zSql);
1919		for(i=1; i<nCol; i++){
1920		zSql[j++] = ',';
1921		zSql[j++] = '?';
1922		}
1923		zSql[j++] = ')';
1924		zSql[j] = 0;
1925		rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0);
1926		Jim_Free(zSql);
1927		if( rc ){
1928		Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db));
1929		sqlite3_finalize(pStmt);
1930		return JIM_ERR;
1931		}
1932		in = fopen(zFile, "rb");
1933		if( in==0 ){
1934		Jim_SetResultFormatted(interp, "Error: cannot open file: %s", zFile);
1935		sqlite3_finalize(pStmt);
1936		return JIM_ERR;
1937		}
1938		azCol = Jim_Alloc( sizeof(azCol[0])*(nCol+1) );
1939		(void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0);
1940		zCommit = "COMMIT";
1941		while( (zLine = local_getline(0, in))!=0 ){
1942		char *z;
1943		i = 0;
1944		lineno++;
1945		azCol[0] = zLine;
1946		for(i=0, z=zLine; *z; z++){
1947		if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){
1948		*z = 0;
1949		i++;
1950		if( i<nCol ){
1951		azCol[i] = &z[nSep];
1952		z += nSep-1;
1953		}
1954		}
1955		}
1956		if( i+1!=nCol ){
1957		char *zErr;
1958		int nErr = strlen30(zFile) + 200;
1959		zErr = Jim_Alloc(nErr);
1960		sqlite3_snprintf(nErr, zErr,
1961		"Error: %s line %d: expected %d columns of data but found %d",
1962		zFile, lineno, nCol, i+1);
1963		Jim_SetResultString(interp, zErr, -1);
1964		Jim_Free(zErr);
1965		zCommit = "ROLLBACK";
1966		break;
1967		}
1968		for(i=0; i<nCol; i++){
1969		/* check for null data, if so, bind as null */
1970		if( (nNull>0 && strcmp(azCol[i], zNull)==0)
1971		\|\| strlen30(azCol[i])==0
1972		){
1973		sqlite3_bind_null(pStmt, i+1);
1974		}else{
1975		sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC);
1976		}
1977		}
1978		sqlite3_step(pStmt);
1979		rc = sqlite3_reset(pStmt);
1980		Jim_Free(zLine);
1981		if( rc!=SQLITE_OK ){
1982		Jim_SetResultFormatted(interp, "Error: %s", sqlite3_errmsg(pDb->db));
1983		zCommit = "ROLLBACK";
1984		break;
1985		}
1986		}
1987		Jim_Free(azCol);
1988		fclose(in);
1989		sqlite3_finalize(pStmt);
1990		(void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0);
1991
1992		if( zCommit[0] == 'C' ){
1993		/* success, set result as number of lines processed */
1994		Jim_SetResultInt(interp, lineno);
1995		rc = JIM_OK;
1996		}else{
1997		/* failure, append lineno where failed */
1998		sqlite3_snprintf(sizeof(zLineNum), zLineNum,"%d",lineno);
1999		Jim_AppendStrings(interp, Jim_GetResult(interp), ", failed while processing line: ", zLineNum, NULL);
2000		rc = JIM_ERR;
2001		}
2002		break;
2003		}
2004
2005		/*
2006		** $db enable_load_extension BOOLEAN
2007		**
2008		** Turn the extension loading feature on or off. It if off by
2009		** default.
2010		*/
2011		case DB_ENABLE_LOAD_EXTENSION: {
2012		#ifndef SQLITE_OMIT_LOAD_EXTENSION
2013		long onoff;
2014		if( objc!=3 ){
2015		Jim_WrongNumArgs(interp, 2, objv, "BOOLEAN");
2016		return JIM_ERR;
2017		}
2018		if( Jim_GetLong(interp, objv[2], &onoff) ){
2019		return JIM_ERR;
2020		}
2021		sqlite3_enable_load_extension(pDb->db, onoff);
2022		break;
2023		#else
2024		Jim_SetResultString(interp, "extension loading is turned off at compile-time", -1);
2025		return JIM_ERR;
2026		#endif
2027		}
2028
2029		/*
2030		** $db errorcode
2031		**
2032		** Return the numeric error code that was returned by the most recent
2033		** call to sqlite3_exec().
2034		*/
2035		case DB_ERRORCODE: {
2036		Jim_SetResultInt(interp, sqlite3_errcode(pDb->db));
2037		break;
2038		}
2039
2040		/*
2041		** $db exists $sql
2042		** $db onecolumn $sql
2043		**
2044		** The onecolumn method is the equivalent of:
2045		** lindex [$db eval $sql] 0
2046		*/
2047		case DB_EXISTS:
2048		case DB_ONECOLUMN: {
2049		DbEvalContext sEval;
2050		if( objc!=3 ){
2051		Jim_WrongNumArgs(interp, 2, objv, "SQL");
2052		return JIM_ERR;
2053		}
2054
2055		dbEvalInit(&sEval, pDb, objv[2], 0);
2056		rc = dbEvalStep(&sEval);
2057		if( choice==DB_ONECOLUMN ){
2058		if( rc==JIM_OK ){
2059		Jim_SetResult(interp, dbEvalColumnValue(&sEval, 0));
2060		}
2061		}else if( rc==JIM_BREAK \|\| rc==JIM_OK ){
2062		Jim_SetResultInt(interp, rc==JIM_OK);
2063		}
2064		dbEvalFinalize(&sEval);
2065
2066		if( rc==JIM_BREAK ){
2067		rc = JIM_OK;
2068		}
2069		break;
2070		}
2071
2072		/*
2073		** $db eval $sql ?array? ?{ ...code... }?
2074		**
2075		** The SQL statement in $sql is evaluated. For each row, the values are
2076		** placed in elements of the array named "array" and ...code... is executed.
2077		** If "array" and "code" are omitted, then no callback is every invoked.
2078		** If "array" is an empty string, then the values are placed in variables
2079		** that have the same name as the fields extracted by the query.
2080		*/
2081		case DB_EVAL: {
2082		if( objc<3 \|\| objc>5 ){
2083		Jim_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
2084		return JIM_ERR;
2085		}
2086
2087		if( objc==3 ){
2088		DbEvalContext sEval;
2089		Jim_Obj *pRet = Jim_NewListObj(interp, NULL, 0);
2090		Jim_IncrRefCount(pRet);
2091		dbEvalInit(&sEval, pDb, objv[2], 0);
2092		while( JIM_OK==(rc = dbEvalStep(&sEval)) ){
2093		int i;
2094		int nCol;
2095		dbEvalRowInfo(&sEval, &nCol, 0);
2096		for(i=0; i<nCol; i++){
2097		Jim_ListAppendElement(interp, pRet, dbEvalColumnValue(&sEval, i));
2098		}
2099		}
2100		dbEvalFinalize(&sEval);
2101		if( rc==JIM_BREAK ){
2102		Jim_SetResult(interp, pRet);
2103		rc = JIM_OK;
2104		}
2105		Jim_DecrRefCount(interp, pRet);
2106		}else{
2107		DbEvalContext *p;
2108		Jim_Obj *pArray = 0;
2109		Jim_Obj *pScript;
2110
2111		if( objc==5 && Jim_Length(objv[3]) ){
2112		pArray = objv[3];
2113		}
2114		pScript = objv[objc-1];
2115		Jim_IncrRefCount(pScript);
2116
2117		p = (DbEvalContext *)Jim_Alloc(sizeof(DbEvalContext));
2118		dbEvalInit(p, pDb, objv[2], pArray);
2119
2120		rc = DbEvalNextCmd(interp, p, pScript, JIM_OK);
2121		}
2122		break;
2123		}
2124
2125		/*
2126		** $db function NAME [-argcount N] SCRIPT
2127		**
2128		** Create a new SQL function called NAME. Whenever that function is
2129		** called, invoke SCRIPT to evaluate the function.
2130		*/
2131		case DB_FUNCTION: {
2132		SqlFunc *pFunc;
2133		Jim_Obj *pScript;
2134		const char *zName;
2135		long nArg = -1;
2136		if( objc==6 ){
2137		const char *z = Jim_String(objv[3]);
2138		int n = strlen30(z);
2139		if( n>2 && strncmp(z, "-argcount",n)==0 ){
2140		if( Jim_GetLong(interp, objv[4], &nArg) ) return JIM_ERR;
2141		if( nArg<0 ){
2142		Jim_SetResultString(interp, "number of arguments must be non-negative", -1);
2143		return JIM_ERR;
2144		}
2145		}
2146		pScript = objv[5];
2147		}else if( objc!=4 ){
2148		Jim_WrongNumArgs(interp, 2, objv, "NAME [-argcount N] SCRIPT");
2149		return JIM_ERR;
2150		}else{
2151		pScript = objv[3];
2152		}
2153		zName = Jim_String(objv[2]);
2154		pFunc = findSqlFunc(pDb, zName);
2155		if( pFunc==0 ) return JIM_ERR;
2156		if( pFunc->pScript ){
2157		Jim_DecrRefCount(interp, pFunc->pScript);
2158		}
2159		pFunc->pScript = pScript;
2160		Jim_IncrRefCount(pScript);
2161		pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript);
2162		rc = sqlite3_create_function(pDb->db, zName, nArg, SQLITE_UTF8,
2163		pFunc, tclSqlFunc, 0, 0);
2164		if( rc!=SQLITE_OK ){
2165		rc = JIM_ERR;
2166		Jim_SetResultString(interp, (char *)sqlite3_errmsg(pDb->db), -1);
2167		}
2168		break;
2169		}
2170
2171		/*
2172		** $db incrblob ?-readonly? ?DB? TABLE COLUMN ROWID
2173		*/
2174		case DB_INCRBLOB: {
2175		#ifdef SQLITE_OMIT_INCRBLOB
2176		Jim_SetResultString(interp, "incrblob not available in this build", -1);
2177		return JIM_ERR;
2178		#else
2179		int isReadonly = 0;
2180		const char *zDb = "main";
2181		const char *zTable;
2182		const char *zColumn;
2183		sqlite_int64 iRow;
2184
2185		/* Check for the -readonly option */
2186		if( objc>3 && strcmp(Jim_GetString(objv[2]), "-readonly")==0 ){
2187		isReadonly = 1;
2188		}
2189
2190		if( objc!=(5+isReadonly) && objc!=(6+isReadonly) ){
2191		Jim_WrongNumArgs(interp, 2, objv, "?-readonly? ?DB? TABLE COLUMN ROWID");
2192		return JIM_ERR;
2193		}
2194
2195		if( objc==(6+isReadonly) ){
2196		zDb = Jim_GetString(objv[2]);
2197		}
2198		zTable = Jim_GetString(objv[objc-3]);
2199		zColumn = Jim_GetString(objv[objc-2]);
2200		rc = Jim_GetWide(interp, objv[objc-1], &iRow);
2201
2202		if( rc==JIM_OK ){
2203		rc = createIncrblobChannel(
2204		interp, pDb, zDb, zTable, zColumn, iRow, isReadonly
2205		);
2206		}
2207		#endif
2208		break;
2209		}
2210
2211		/*
2212		** $db interrupt
2213		**
2214		** Interrupt the execution of the inner-most SQL interpreter. This
2215		** causes the SQL statement to return an error of SQLITE_INTERRUPT.
2216		*/
2217		case DB_INTERRUPT: {
2218		sqlite3_interrupt(pDb->db);
2219		break;
2220		}
2221
2222		/*
2223		** $db nullvalue ?STRING?
2224		**
2225		** Change text used when a NULL comes back from the database. If ?STRING?
2226		** is not present, then the current string used for NULL is returned.
2227		** If STRING is present, then STRING is returned.
2228		**
2229		*/
2230		case DB_NULLVALUE: {
2231		if( objc!=2 && objc!=3 ){
2232		Jim_WrongNumArgs(interp, 2, objv, "NULLVALUE");
2233		return JIM_ERR;
2234		}
2235		if( objc==3 ){
2236		int len;
2237		const char *zNull = Jim_GetString(objv[2], &len);
2238		if( pDb->zNull ){
2239		Jim_Free(pDb->zNull);
2240		}
2241		if( zNull && len>0 ){
2242		pDb->zNull = Jim_Alloc( len + 1 );
2243		strncpy(pDb->zNull, zNull, len);
2244		pDb->zNull[len] = '\0';
2245		}else{
2246		pDb->zNull = 0;
2247		}
2248		}
2249		Jim_SetResult(interp, dbTextToObj(interp, pDb->zNull));
2250		break;
2251		}
2252
2253		/*
2254		** $db last_insert_rowid
2255		**
2256		** Return an integer which is the ROWID for the most recent insert.
2257		*/
2258		case DB_LAST_INSERT_ROWID: {
2259		if( objc!=2 ){
2260		Jim_WrongNumArgs(interp, 2, objv, "");
2261		return JIM_ERR;
2262		}
2263		Jim_SetResultInt(interp, sqlite3_last_insert_rowid(pDb->db));
2264		break;
2265		}
2266
2267		/*
2268		** The DB_ONECOLUMN method is implemented together with DB_EXISTS.
2269		*/
2270
2271		/* $db progress ?N CALLBACK?
2272		**
2273		** Invoke the given callback every N virtual machine opcodes while executing
2274		** queries.
2275		*/
2276		case DB_PROGRESS: {
2277		if( objc==2 ){
2278		if( pDb->zProgress ){
2279		Jim_AppendString(interp, Jim_GetResult(interp), pDb->zProgress, -1);
2280		}
2281		}else if( objc==4 ){
2282		const char *zProgress;
2283		int len;
2284		long N;
2285		if( JIM_OK!=Jim_GetLong(interp, objv[2], &N) ){
2286		return JIM_ERR;
2287		};
2288		if( pDb->zProgress ){
2289		Jim_Free(pDb->zProgress);
2290		}
2291		zProgress = Jim_GetString(objv[3], &len);
2292		if( zProgress && len>0 ){
2293		pDb->zProgress = Jim_Alloc( len + 1 );
2294		memcpy(pDb->zProgress, zProgress, len+1);
2295		}else{
2296		pDb->zProgress = 0;
2297		}
2298		#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
2299		if( pDb->zProgress ){
2300		pDb->interp = interp;
2301		sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
2302		}else{
2303		sqlite3_progress_handler(pDb->db, 0, 0, 0);
2304		}
2305		#endif
2306		}else{
2307		Jim_WrongNumArgs(interp, 2, objv, "N CALLBACK");
2308		return JIM_ERR;
2309		}
2310		break;
2311		}
2312
2313		/* $db profile ?CALLBACK?
2314		**
2315		** Make arrangements to invoke the CALLBACK routine after each SQL statement
2316		** that has run. The text of the SQL and the amount of elapse time are
2317		** appended to CALLBACK before the script is run.
2318		*/
2319		case DB_PROFILE: {
2320		if( objc>3 ){
2321		Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2322		return JIM_ERR;
2323		}else if( objc==2 ){
2324		if( pDb->zProfile ){
2325		Jim_SetResultString(interp, pDb->zProfile, -1);
2326		}
2327		}else{
2328		const char *zProfile;
2329		int len;
2330		if( pDb->zProfile ){
2331		Jim_Free(pDb->zProfile);
2332		}
2333		zProfile = Jim_GetString(objv[2], &len);
2334		if( zProfile && len>0 ){
2335		pDb->zProfile = Jim_Alloc( len + 1 );
2336		memcpy(pDb->zProfile, zProfile, len+1);
2337		}else{
2338		pDb->zProfile = 0;
2339		}
2340		#ifndef SQLITE_OMIT_TRACE
2341		if( pDb->zProfile ){
2342		pDb->interp = interp;
2343		sqlite3_profile(pDb->db, DbProfileHandler, pDb);
2344		}else{
2345		sqlite3_profile(pDb->db, 0, 0);
2346		}
2347		#endif
2348		}
2349		break;
2350		}
2351
2352		/*
2353		** $db rekey KEY
2354		**
2355		** Change the encryption key on the currently open database.
2356		*/
2357		case DB_REKEY: {
2358		int nKey;
2359		const char *pKey;
2360		if( objc!=3 ){
2361		Jim_WrongNumArgs(interp, 2, objv, "KEY");
2362		return JIM_ERR;
2363		}
2364		//pKey = Jim_GetByteArrayFromObj(objv[2], &nKey);
2365		pKey = Jim_GetString(objv[2], &nKey);
2366		#ifdef SQLITE_HAS_CODEC
2367		rc = sqlite3_rekey(pDb->db, pKey, nKey);
2368		if( rc ){
2369		Jim_SetResultString(interp, sqlite3ErrStr(rc), -1);
2370		rc = JIM_ERR;
2371		}
2372		#endif
2373		break;
2374		}
2375
2376		/* $db restore ?DATABASE? FILENAME
2377		**
2378		** Open a database file named FILENAME. Transfer the content
2379		** of FILENAME into the local database DATABASE (default: "main").
2380		*/
2381		case DB_RESTORE: {
2382		const char *zSrcFile;
2383		const char *zDestDb;
2384		sqlite3 *pSrc;
2385		sqlite3_backup *pBackup;
2386		int nTimeout = 0;
2387
2388		if( objc==3 ){
2389		zDestDb = "main";
2390		zSrcFile = Jim_String(objv[2]);
2391		}else if( objc==4 ){
2392		zDestDb = Jim_String(objv[2]);
2393		zSrcFile = Jim_String(objv[3]);
2394		}else{
2395		Jim_WrongNumArgs(interp, 2, objv, "?DATABASE? FILENAME");
2396		return JIM_ERR;
2397		}
2398		rc = sqlite3_open_v2(zSrcFile, &pSrc, SQLITE_OPEN_READONLY, 0);
2399		if( rc!=SQLITE_OK ){
2400		Jim_SetResultFormatted(interp, "cannot open source database: %s", sqlite3_errmsg(pSrc));
2401		sqlite3_close(pSrc);
2402		return JIM_ERR;
2403		}
2404		pBackup = sqlite3_backup_init(pDb->db, zDestDb, pSrc, "main");
2405		if( pBackup==0 ){
2406		Jim_SetResultFormatted(interp, "restore failed: %s", sqlite3_errmsg(pDb->db));
2407		sqlite3_close(pSrc);
2408		return JIM_ERR;
2409		}
2410		while( (rc = sqlite3_backup_step(pBackup,100))==SQLITE_OK
2411		\|\| rc==SQLITE_BUSY ){
2412		if( rc==SQLITE_BUSY ){
2413		if( nTimeout++ >= 3 ) break;
2414		sqlite3_sleep(100);
2415		}
2416		}
2417		sqlite3_backup_finish(pBackup);
2418		if( rc==SQLITE_DONE ){
2419		rc = JIM_OK;
2420		}else if( rc==SQLITE_BUSY \|\| rc==SQLITE_LOCKED ){
2421		Jim_SetResultString(interp, "restore failed: source database busy", -1);
2422		rc = JIM_ERR;
2423		}else{
2424		Jim_SetResultFormatted(interp, "restore failed: %s", sqlite3_errmsg(pDb->db));
2425		rc = JIM_ERR;
2426		}
2427		sqlite3_close(pSrc);
2428		break;
2429		}
2430
2431		/*
2432		** $db status (step\|sort)
2433		**
2434		** Display SQLITE_STMTSTATUS_FULLSCAN_STEP or
2435		** SQLITE_STMTSTATUS_SORT for the most recent eval.
2436		*/
2437		case DB_STATUS: {
2438		int v;
2439		const char *zOp;
2440		if( objc!=3 ){
2441		Jim_WrongNumArgs(interp, 2, objv, "(step\|sort)");
2442		return JIM_ERR;
2443		}
2444		zOp = Jim_String(objv[2]);
2445		if( strcmp(zOp, "step")==0 ){
2446		v = pDb->nStep;
2447		}else if( strcmp(zOp, "sort")==0 ){
2448		v = pDb->nSort;
2449		}else{
2450		Jim_SetResultString(interp, "bad argument: should be step or sort", -1);
2451		return JIM_ERR;
2452		}
2453		Jim_SetResultInt(interp, v);
2454		break;
2455		}
2456
2457		/*
2458		** $db timeout MILLESECONDS
2459		**
2460		** Delay for the number of milliseconds specified when a file is locked.
2461		*/
2462		case DB_TIMEOUT: {
2463		long ms;
2464		if( objc!=3 ){
2465		Jim_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
2466		return JIM_ERR;
2467		}
2468		if( Jim_GetLong(interp, objv[2], &ms) ) return JIM_ERR;
2469		sqlite3_busy_timeout(pDb->db, ms);
2470		break;
2471		}
2472
2473		/*
2474		** $db total_changes
2475		**
2476		** Return the number of rows that were modified, inserted, or deleted
2477		** since the database handle was created.
2478		*/
2479		case DB_TOTAL_CHANGES: {
2480		if( objc!=2 ){
2481		Jim_WrongNumArgs(interp, 2, objv, "");
2482		return JIM_ERR;
2483		}
2484		Jim_SetResultInt(interp, sqlite3_total_changes(pDb->db));
2485		break;
2486		}
2487
2488		/* $db trace ?CALLBACK?
2489		**
2490		** Make arrangements to invoke the CALLBACK routine for each SQL statement
2491		** that is executed. The text of the SQL is appended to CALLBACK before
2492		** it is executed.
2493		*/
2494		case DB_TRACE: {
2495		if( objc>3 ){
2496		Jim_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
2497		return JIM_ERR;
2498		}else if( objc==2 ){
2499		if( pDb->zTrace ){
2500		Jim_AppendString(interp, Jim_GetResult(interp), pDb->zTrace, -1);
2501		}
2502		}else{
2503		const char *zTrace;
2504		int len;
2505		if( pDb->zTrace ){
2506		Jim_Free(pDb->zTrace);
2507		}
2508		zTrace = Jim_GetString(objv[2], &len);
2509		if( zTrace && len>0 ){
2510		pDb->zTrace = Jim_Alloc( len + 1 );
2511		memcpy(pDb->zTrace, zTrace, len+1);
2512		}else{
2513		pDb->zTrace = 0;
2514		}
2515		#ifndef SQLITE_OMIT_TRACE
2516		if( pDb->zTrace ){
2517		pDb->interp = interp;
2518		sqlite3_trace(pDb->db, DbTraceHandler, pDb);
2519		}else{
2520		sqlite3_trace(pDb->db, 0, 0);
2521		}
2522		#endif
2523		}
2524		break;
2525		}
2526
2527		/* $db transaction [-deferred\|-immediate\|-exclusive] SCRIPT
2528		**
2529		** Start a new transaction (if we are not already in the midst of a
2530		** transaction) and execute the TCL script SCRIPT. After SCRIPT
2531		** completes, either commit the transaction or roll it back if SCRIPT
2532		** throws an exception. Or if no new transation was started, do nothing.
2533		** pass the exception on up the stack.
2534		**
2535		** This command was inspired by Dave Thomas's talk on Ruby at the
2536		** 2005 O'Reilly Open Source Convention (OSCON).
2537		*/
2538		case DB_TRANSACTION: {
2539		Jim_Obj *pScript;
2540		const char *zBegin = "SAVEPOINT _tcl_transaction";
2541		if( objc!=3 && objc!=4 ){
2542		Jim_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT");
2543		return JIM_ERR;
2544		}
2545
2546		if( pDb->nTransaction==0 && objc==4 ){
2547		static const char *TTYPE_strs[] = {
2548		"deferred", "exclusive", "immediate", 0
2549		};
2550		enum TTYPE_enum {
2551		TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
2552		};
2553		int ttype;
2554		if( Jim_GetEnum(interp, objv[2], TTYPE_strs, &ttype, "transaction type", JIM_ERRMSG \| JIM_ENUM_ABBREV) ){
2555		return JIM_ERR;
2556		}
2557		switch( (enum TTYPE_enum)ttype ){
2558		case TTYPE_DEFERRED: /* no-op */; break;
2559		case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break;
2560		case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break;
2561		}
2562		}
2563		pScript = objv[objc-1];
2564
2565		/* Run the SQLite BEGIN command to open a transaction or savepoint. */
2566		pDb->disableAuth++;
2567		rc = sqlite3_exec(pDb->db, zBegin, 0, 0, 0);
2568		pDb->disableAuth--;
2569		if( rc!=SQLITE_OK ){
2570		Jim_SetResultString(interp, sqlite3_errmsg(pDb->db), -1);
2571		return JIM_ERR;
2572		}
2573		pDb->nTransaction++;
2574
2575		/* No NRE in Jim Tcl, so evaluate the script directly, then
2576		** call function DbTransPostCmd() to commit (or rollback) the transaction
2577		** or savepoint. */
2578		rc = DbTransPostCmd(interp, pDb, Jim_EvalObj(interp, pScript));
2579		break;
2580		}
2581
2582		/*
2583		** $db unlock_notify ?script?
2584		*/
2585		case DB_UNLOCK_NOTIFY: {
2586		#ifndef SQLITE_ENABLE_UNLOCK_NOTIFY
2587		Jim_SetResultString(interp, "unlock_notify not available in this build", -1);
2588		rc = JIM_ERR;
2589		#else
2590		if( objc!=2 && objc!=3 ){
2591		Jim_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
2592		rc = JIM_ERR;
2593		}else{
2594		void (xNotify)(void *, int) = 0;
2595		void *pNotifyArg = 0;
2596
2597		if( pDb->pUnlockNotify ){
2598		Jim_DecrRefCount(interp, pDb->pUnlockNotify);
2599		pDb->pUnlockNotify = 0;
2600		}
2601
2602		if( objc==3 ){
2603		xNotify = DbUnlockNotify;
2604		pNotifyArg = (void *)pDb;
2605		pDb->pUnlockNotify = objv[2];
2606		Jim_IncrRefCount(pDb->pUnlockNotify);
2607		}
2608
2609		if( sqlite3_unlock_notify(pDb->db, xNotify, pNotifyArg) ){
2610		Jim_SetResultString(interp, sqlite3_errmsg(pDb->db), -1);
2611		rc = JIM_ERR;
2612		}
2613		}
2614		#endif
2615		break;
2616		}
2617
2618		/*
2619		** $db update_hook ?script?
2620		** $db rollback_hook ?script?
2621		*/
2622		case DB_UPDATE_HOOK:
2623		case DB_ROLLBACK_HOOK: {
2624
2625		/* set ppHook to point at pUpdateHook or pRollbackHook, depending on
2626		** whether [$db update_hook] or [$db rollback_hook] was invoked.
2627		*/
2628		Jim_Obj **ppHook;
2629		if( choice==DB_UPDATE_HOOK ){
2630		ppHook = &pDb->pUpdateHook;
2631		}else{
2632		ppHook = &pDb->pRollbackHook;
2633		}
2634
2635		if( objc!=2 && objc!=3 ){
2636		Jim_WrongNumArgs(interp, 2, objv, "?SCRIPT?");
2637		return JIM_ERR;
2638		}
2639		if( *ppHook ){
2640		Jim_SetResult(interp, *ppHook);
2641		if( objc==3 ){
2642		Jim_DecrRefCount(interp, *ppHook);
2643		*ppHook = 0;
2644		}
2645		}
2646		if( objc==3 ){
2647		assert( !(*ppHook) );
2648		if( Jim_Length(objv[2])>0 ){
2649		*ppHook = objv[2];
2650		Jim_IncrRefCount(*ppHook);
2651		}
2652		}
2653
2654		sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb);
2655		sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb);
2656
2657		break;
2658		}
2659
2660		/* $db version
2661		**
2662		** Return the version string for this database.
2663		*/
2664		case DB_VERSION: {
2665		Jim_SetResultString(interp, sqlite3_libversion(), -1);
2666		break;
2667		}
2668
2669
2670		} /* End of the SWITCH statement */
2671		return rc;
2672		}
2673
2674		/*
2675		** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
2676		** ?-create BOOLEAN? ?-nomutex BOOLEAN?
2677		**
2678		** This is the main Tcl command. When the "sqlite" Tcl command is
2679		** invoked, this routine runs to process that command.
2680		**
2681		** The first argument, DBNAME, is an arbitrary name for a new
2682		** database connection. This command creates a new command named
2683		** DBNAME that is used to control that connection. The database
2684		** connection is deleted when the DBNAME command is deleted.
2685		**
2686		** The second argument is the name of the database file.
2687		**
2688		*/
2689		static int DbMain(Jim_Interp interp, int objc, Jim_Obj const*objv){
2690		SqliteDb *p;
2691		const char *pKey = 0;
2692		int nKey = 0;
2693		const char *zArg;
2694		char *zErrMsg;
2695		int i;
2696		const char *zFile;
2697		const char *zVfs = 0;
2698		int flags;
2699
2700		/* Not threading in Jim, so no mutexing is needed */
2701		flags = SQLITE_OPEN_READWRITE \| SQLITE_OPEN_CREATE \| SQLITE_OPEN_NOMUTEX;
2702
2703		if( objc==2 ){
2704		zArg = Jim_String(objv[1]);
2705		if( strcmp(zArg,"-version")==0 ){
2706		Jim_SetResultString(interp, sqlite3_version, -1);
2707		return JIM_OK;
2708		}
2709		if( strcmp(zArg,"-has-codec")==0 ){
2710		#ifdef SQLITE_HAS_CODEC
2711		Jim_SetResultInt(interp, 1);
2712		#else
2713		Jim_SetResultInt(interp, 0);
2714		#endif
2715		return JIM_OK;
2716		}
2717		}
2718		for(i=3; i+1<objc; i+=2){
2719		zArg = Jim_String(objv[i]);
2720		if( strcmp(zArg,"-key")==0 ){
2721		pKey = Jim_GetString(objv[i+1], &nKey);
2722		}else if( strcmp(zArg, "-vfs")==0 ){
2723		i++;
2724		zVfs = Jim_String(objv[i]);
2725		}else if( strcmp(zArg, "-readonly")==0 ){
2726		long b;
2727		if( Jim_GetLong(interp, objv[i+1], &b) ) return JIM_ERR;
2728		if( b ){
2729		flags &= ~(SQLITE_OPEN_READWRITE\|SQLITE_OPEN_CREATE);
2730		flags \|= SQLITE_OPEN_READONLY;
2731		}else{
2732		flags &= ~SQLITE_OPEN_READONLY;
2733		flags \|= SQLITE_OPEN_READWRITE;
2734		}
2735		}else if( strcmp(zArg, "-create")==0 ){
2736		long b;
2737		if( Jim_GetLong(interp, objv[i+1], &b) ) return JIM_ERR;
2738		if( b && (flags & SQLITE_OPEN_READONLY)==0 ){
2739		flags \|= SQLITE_OPEN_CREATE;
2740		}else{
2741		flags &= ~SQLITE_OPEN_CREATE;
2742		}
2743		}else if( strcmp(zArg, "-nomutex")==0 ){
2744		long b;
2745		if( Jim_GetLong(interp, objv[i+1], &b) ) return JIM_ERR;
2746		if( b ){
2747		flags \|= SQLITE_OPEN_NOMUTEX;
2748		flags &= ~SQLITE_OPEN_FULLMUTEX;
2749		}else{
2750		flags &= ~SQLITE_OPEN_NOMUTEX;
2751		}
2752		}else if( strcmp(zArg, "-fullmutex")==0 ){
2753		long b;
2754		if( Jim_GetLong(interp, objv[i+1], &b) ) return JIM_ERR;
2755		if( b ){
2756		flags \|= SQLITE_OPEN_FULLMUTEX;
2757		flags &= ~SQLITE_OPEN_NOMUTEX;
2758		}else{
2759		flags &= ~SQLITE_OPEN_FULLMUTEX;
2760		}
2761		}else{
2762		Jim_SetResultFormatted(interp, "unknown option: %s", zArg);
2763		return JIM_ERR;
2764		}
2765		}
2766		if( objc<3 \|\| (objc&1)!=1 ){
2767		Jim_WrongNumArgs(interp, 1, objv,
2768		"HANDLE FILENAME ?-vfs VFSNAME? ?-readonly BOOLEAN? ?-create BOOLEAN?"
2769		" ?-nomutex BOOLEAN? ?-fullmutex BOOLEAN?"
2770		#ifdef SQLITE_HAS_CODEC
2771		" ?-key CODECKEY?"
2772		#endif
2773		);
2774		return JIM_ERR;
2775		}
2776		zErrMsg = 0;
2777		p = (SqliteDb)Jim_Alloc( sizeof(p) );
2778		memset(p, 0, sizeof(*p));
2779		zFile = Jim_String(objv[2]);
2780		sqlite3_open_v2(zFile, &p->db, flags, zVfs);
2781		if( SQLITE_OK!=sqlite3_errcode(p->db) ){
2782		zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db));
2783		sqlite3_close(p->db);
2784		p->db = 0;
2785		}
2786		#ifdef SQLITE_HAS_CODEC
2787		if( p->db ){
2788		sqlite3_key(p->db, pKey, nKey);
2789		}
2790		#endif
2791		if( p->db==0 ){
2792		Jim_SetResultString(interp, zErrMsg, -1);
2793		Jim_Free((char*)p);
2794		sqlite3_free(zErrMsg);
2795		return JIM_ERR;
2796		}
2797		p->maxStmt = NUM_PREPARED_STMTS;
2798		p->interp = interp;
2799		zArg = Jim_String(objv[1]);
2800		Jim_CreateCommand(interp, zArg, DbObjCmd, p, DbDeleteCmd);
2801		return JIM_OK;
2802		}
2803
2804		/*
2805		** Make sure we have a PACKAGE_VERSION macro defined. This will be
2806		** defined automatically by the TEA makefile. But other makefiles
2807		** do not define it.
2808		*/
2809		#ifndef PACKAGE_VERSION
2810		# define PACKAGE_VERSION SQLITE_VERSION
2811		#endif
2812
2813		#define EXTERN
2814		/*
2815		** Initialize this module.
2816		**
2817		** This Tcl module contains only a single new Tcl command named "sqlite".
2818		** (Hence there is no namespace. There is no point in using a namespace
2819		** if the extension only supplies one new name!) The "sqlite" command is
2820		** used to open a new SQLite database. See the DbMain() routine above
2821		** for additional information.
2822		*/
2823		EXTERN int Jim_sqlite3Init(Jim_Interp *interp){
2824		Jim_CreateCommand(interp, "sqlite3", DbMain, 0, 0);
2825		Jim_PackageProvide(interp, "sqlite3", PACKAGE_VERSION, 0);
2826		Jim_CreateCommand(interp, "sqlite", DbMain, 0, 0);
2827		Jim_PackageProvide(interp, "sqlite", PACKAGE_VERSION, 0);
2828		return JIM_OK;
2829		}

+51

-0

sqlite3/test-sqlite.tcl less more

	0	# A simple test of the "big" sqlite extension
	1
	2	set auto_path [list . {*}$auto_path]
	3
	4	package require sqlite
	5
	6	# Create an in-memory database and add some data
	7	sqlite db :memory:
	8	db eval {CREATE TABLE history (type, time, value)}
	9	foreach t [range 1 50] {
	10	set temp [rand 100]
	11	db eval {INSERT INTO history (type, time, value) VALUES ('temp', :t, :temp)}
	12	}
	13	foreach t [range 2 50 2] {
	14	set v $([rand 200] / 10.0 + 5)
	15	db eval {INSERT INTO history (type, time, value) VALUES ('voltage', :t, :v)}
	16	}
	17
	18	# Output some data in SVG format.
	19	puts "\nSVG Example\n"
	20
	21	set points {}
	22	db eval {SELECT time,value FROM history
	23	WHERE (time >= 10 and time <= 30) and type = 'voltage'
	24	ORDER BY time DESC} row {
	25	lappend points $row(time),$row(value)
	26	}
	27	puts "<polyline points=\"$points\" />"
	28
	29	# And tabular format with a self outer join
	30	puts "\nTabular Self Outer Join Example\n"
	31
	32	proc showrow {args} {
	33	puts [format "%-12s %-12s %-12s" {*}$args]
	34	}
	35
	36	showrow Time Temp Voltage
	37	showrow ---- ---- -------
	38	db eval {SELECT * FROM (SELECT time, value AS temp FROM history WHERE type = 'temp') AS A
	39	LEFT OUTER JOIN (SELECT time, value AS voltage FROM history WHERE type = 'voltage') AS B
	40	USING (time)
	41	WHERE time >= 10 AND time <= 30
	42	ORDER BY time} row {
	43	showrow $row(time) $row(temp) $row(voltage)
	44	}
	45	set maxtemp [db eval {SELECT max(value) FROM history WHERE type = 'temp'}]
	46	set maxvolt [db eval {SELECT max(value) AS maxvolt FROM history WHERE type = 'voltage'}]
	47	showrow ---- ---- -------
	48	showrow max $maxtemp $maxvolt
	49
	50	db close

-51

~~sqlite3/test-sqlite3.tcl~~ less more

0		# A simple test of the "big" sqlite3 extension
1
2		set auto_path [list . {*}$auto_path]
3
4		package require sqlite3
5
6		# Create an in-memory database and add some data
7		sqlite3 db :memory:
8		db eval {CREATE TABLE history (type, time, value)}
9		foreach t [range 1 50] {
10		set temp [rand 100]
11		db eval {INSERT INTO history (type, time, value) VALUES ('temp', :t, :temp)}
12		}
13		foreach t [range 2 50 2] {
14		set v $([rand 200] / 10.0 + 5)
15		db eval {INSERT INTO history (type, time, value) VALUES ('voltage', :t, :v)}
16		}
17
18		# Output some data in SVG format.
19		puts "\nSVG Example\n"
20
21		set points {}
22		db eval {SELECT time,value FROM history
23		WHERE (time >= 10 and time <= 30) and type = 'voltage'
24		ORDER BY time DESC} row {
25		lappend points $row(time),$row(value)
26		}
27		puts "<polyline points=\"$points\" />"
28
29		# And tabular format with a self outer join
30		puts "\nTabular Self Outer Join Example\n"
31
32		proc showrow {args} {
33		puts [format "%-12s %-12s %-12s" {*}$args]
34		}
35
36		showrow Time Temp Voltage
37		showrow ---- ---- -------
38		db eval {SELECT * FROM (SELECT time, value AS temp FROM history WHERE type = 'temp') AS A
39		LEFT OUTER JOIN (SELECT time, value AS voltage FROM history WHERE type = 'voltage') AS B
40		USING (time)
41		WHERE time >= 10 AND time <= 30
42		ORDER BY time} row {
43		showrow $row(time) $row(temp) $row(voltage)
44		}
45		set maxtemp [db eval {SELECT max(value) FROM history WHERE type = 'temp'}]
46		set maxvolt [db eval {SELECT max(value) AS maxvolt FROM history WHERE type = 'voltage'}]
47		showrow ---- ---- -------
48		showrow max $maxtemp $maxvolt
49
50		db close

-66

tclcompat.tcl less more

180	180	return $pids
181	181	}
182	182
183		# try/on/finally conceptually similar to Tcl 8.6
184		#
185		# Usage: try ?catchopts? script ?onclause ...? ?finallyclause?
186		#
187		# Where:
188		# catchopts is: options for catch such as -nobreak, -signal
189		# onclause is: on codes {?resultvar? ?optsvar?} script
190		# codes is: a list of return codes (ok, error, etc. or integers), or * for any
191		# finallyclause is: finally script
192		proc try {args} {
193		set catchopts {}
194		while {[string match -* [lindex $args 0]]} {
195		set args [lassign $args opt]
196		if {$opt eq "--"} {
197		break
198		}
199		lappend catchopts $opt
200		}
201		if {[llength $args] == 0} {
202		return -code error {wrong # args: should be "try ?options? script ?argument ...?"}
203		}
204		set args [lassign $args script]
205		set code [catch -eval {*}$catchopts {uplevel 1 $script} msg opts]
206
207		set handled 0
208
209		foreach {on codes vars script} $args {
210		switch -- $on \
211		on {
212		if {!$handled && ($codes eq "*" \|\| [info returncode $code] in $codes)} {
213		lassign $vars msgvar optsvar
214		if {$msgvar ne ""} {
215		upvar $msgvar hmsg
216		set hmsg $msg
217		}
218		if {$optsvar ne ""} {
219		upvar $optsvar hopts
220		set hopts $opts
221		}
222		# Override any body result
223		set code [catch {uplevel 1 $script} msg opts]
224		incr handled
225		}
226		} \
227		finally {
228		set finalcode [catch {uplevel 1 $codes} finalmsg finalopts]
229		if {$finalcode} {
230		# Override any body or handler result
231		set code $finalcode
232		set msg $finalmsg
233		set opts $finalopts
234		}
235		break
236		} \
237		default {
238		return -code error "try: expected 'on' or 'finally', got '$on'"
239		}
240		}
241
242		if {$code} {
243		incr opts(-level)
244		return {*}$opts $msg
245		}
246		return $msg
247		}
248
249	183	# Generates an exception with the given code (ok, error, etc. or an integer)
250	184	# and the given message
251	185	proc throw {code {msg ""}} {

+62

-14

tcltest.tcl less more

3	3	set testinfo(verbose) 0
4	4	set testinfo(numpass) 0
5	5	set testinfo(stoponerror) 0
	6	set testinfo(template) 0
6	7	set testinfo(numfail) 0
7	8	set testinfo(numskip) 0
8	9	set testinfo(numtests) 0
9	10	set testinfo(reported) 0
10	11	set testinfo(failed) {}
11
	12	set testinfo(source) [file tail $::argv0]
	13
	14	# -verbose or $testverbose show OK/ERR of individual tests
12	15	if {[lsearch $argv "-verbose"] >= 0 \|\| [info exists env(testverbose)]} {
13	16	incr testinfo(verbose)
14	17	}
	18	# -template causes failed tests to output a template test that would succeed
	19	if {[lsearch $argv "-template"] >= 0} {
	20	incr testinfo(template)
	21	}
	22	# -stoponerror or $stoponerror stops on the first failed test
15	23	if {[lsearch $argv "-stoponerror"] >= 0 \|\| [info exists env(stoponerror)]} {
16	24	incr testinfo(stoponerror)
17	25	}

52	60	error "Unknown needs type: $type"
53	61	}
54	62
	63	# Simplify setting constraints for whether commands exist
	64	proc testCmdConstraints {args} {
	65	foreach cmd $args {
	66	testConstraint $cmd [expr {[info commands $cmd] ne {}}]
	67	}
	68	}
	69
55	70	proc skiptest {{msg {}}} {
56		puts [format "%16s: --- skipped$msg" $::argv0]
	71	puts [format "%16s: --- skipped$msg" $::testinfo(source)]
57	72	exit 0
58	73	}
59	74

136	151	proc script_source {script} {
137	152	lassign [info source $script] f l
138	153	if {$f ne ""} {
139		puts "At : $f:$l"
	154	puts "$f:$l:Error test failure"
140	155	return \t$f:$l
141	156	}
142	157	}

144	159	proc error_source {} {
145	160	lassign [info stacktrace] p f l
146	161	if {$f ne ""} {
147		puts "At : $f:$l"
	162	puts "$f:$l:Error test failure"
148	163	return \t$f:$l
149	164	}
150	165	}

153	168	if {[catch {
154	169	package require $name
155	170	}]} {
156		puts [format "%16s: --- skipped" $::argv0]
	171	puts [format "%16s: --- skipped" $::testinfo(source)]
157	172	exit 0
158	173	}
159	174	}

179	194	return $x
180	195	}
181	196
	197	# Takes a stacktrace and applies [file tail] to the filenames.
	198	# This allows stacktrace tests to be run from a directory other than the source directory.
	199	proc basename-stacktrace {stacktrace} {
	200	set result {}
	201	foreach {p f l} $stacktrace {
	202	lappend result $p [file tail $f] $l
	203	}
	204	return $result
	205	}
	206
	207	# Takes a list of {filename line} and returns {basename line}
	208	proc basename-source {list} {
	209	list [file tail [lindex $list 0]] [lindex $list 1]
	210	}
	211
182	212	# Note: We don't support -output or -errorOutput yet
183	213	proc test {id descr args} {
184		set a [dict create -returnCodes {ok return} -match exact -result {} -constraints {} -body {} -setup {} -cleanup {}]
	214	set default [dict create -returnCodes {ok return} -match exact -result {} -constraints {} -body {} -setup {} -cleanup {}]
	215	set a $default
185	216	if {[lindex $args 0] ni [dict keys $a]} {
186	217	if {[llength $args] == 2} {
187	218	lassign $args body result constraints

224	255
225	256	if {[info return $rc] ni $a(-returnCodes) && $rc ni $a(-returnCodes)} {
226	257	set ok 0
227		set expected "rc=$a(-returnCodes) result=$a(-result)"
228		set result "rc=[info return $rc] result=$result"
	258	set expected "rc=[list $a(-returnCodes)] result=[list $a(-result)]"
	259	set actual "rc=[info return $rc] result=[list $result]"
	260	# Now for the template, update -returnCodes
	261	set a(-returnCodes) [info return $rc]
229	262	} else {
230	263	if {$a(-match) eq "exact"} {
231	264	set ok [string equal $a(-result) $result]

236	269	} else {
237	270	return -code error "$id: unknown match type: $a(-match)"
238	271	}
239		set expected $a(-result)
	272	set actual [list $result]
	273	set expected [list $a(-result)]
240	274	}
241	275
242	276	if {$ok} {

256	290	} else {
257	291	set source [error_source]
258	292	}
259		puts "Expected: '$expected'"
260		puts "Got : '$result'"
	293	puts "Expected: $expected"
	294	puts "Got : $actual"
261	295	puts ""
	296	if {$::testinfo(template)} {
	297	# We can't really do -match glob\|regexp so
	298	# just store the result as-is for -match exact
	299	set a(-result) $result
	300
	301	set template [list test $id $descr]
	302	foreach key {-constraints -setup -body -returnCodes -match -result -cleanup} {
	303	if {$a($key) ne $default($key)} {
	304	lappend template $key $a($key)
	305	}
	306	}
	307	puts "### template"
	308	puts $template\n
	309	}
262	310	incr ::testinfo(numfail)
263	311	lappend ::testinfo(failed) [list $id $descr $source $expected $result]
264	312	if {$::testinfo(stoponerror)} {

278	326	incr ::testinfo(reported)
279	327
280	328	if {$::testinfo(verbose)} {
281		puts -nonewline "\n$::argv0"
282		} else {
283		puts -nonewline [format "%16s" $::argv0]
	329	puts -nonewline "\n$::testinfo(source)"
	330	} else {
	331	puts -nonewline [format "%16s" $::testinfo(source)]
284	332	}
285	333	puts [format ": Total %5d Passed %5d Skipped %5d Failed %5d" \
286	334	$::testinfo(numtests) $::testinfo(numpass) $::testinfo(numskip) $::testinfo(numfail)]

+10

-0

test-bootstrap-jim less more

	0	#!/bin/sh
	1
	2	set -e
	3	echo "Building bootstrap jimsh"
	4	./make-bootstrap-jim >jimsh_bootstrap.c
	5	${CC:-cc} -o jimsh_bootstrap jimsh_bootstrap.c
	6	echo "Testing bootstrap jimsh"
	7	( cd tests; ../jimsh_bootstrap runall.tcl )
	8	echo "All tests passed"
	9	rm jimsh_bootstrap jimsh_bootstrap.c

-4

tests/Makefile.in less more

0	0	jimsh ?= ../jimsh
1	1	tclsh ?= tclsh
2	2
3		DEF_LD_PATH := @LD_LIBRARY_PATH@="@builddir@:$(@LD_LIBRARY_PATH@)"
4
5	3	test:
6		@$(DEF_LD_PATH) $(jimsh) runall.tcl
	4	@LD_LIBRARY_PATH="@builddir@:$(@LD_LIBRARY_PATH@)" "$(jimsh)" "@abs_top_srcdir@/tests/runall.tcl"
7	5
8	6	tcl:
9		@rc=0; for i in *.test; do $(tclsh) -encoding utf-8 $$i \|\| rc=$?; done; exit $$rc
	7	@rc=0; for i in "@abs_top_srcdir@"/tests/*.test; do "$(tclsh)" -encoding utf-8 $$i \|\| rc=$?; done; exit $$rc
10	8
11	9	clean:
12	10	rm -f gorp.file2 gorp.file sleepx test1 exec.tmp1

+159

-0

tests/aio.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3	testCmdConstraints socket
	4	testConstraint posixaio [expr {$tcl_platform(platform) eq {unix} && !$tcl_platform(bootstrap)}]
	5
	6	# Create and open in binary mode for compatibility between Windows and Unix
	7	set f [open testdata.in wb]
	8	$f puts test-data
	9	$f close
	10	set f [open testdata.in rb]
	11
	12	defer {
	13	$f close
	14	file delete testdata.in
	15	}
	16
	17	test aio-1.1 {seek usage} -body {
	18	$f seek
	19	} -returnCodes error -match glob -result {wrong # args: should be "* seek offset ?start\|current\|end"}
	20
	21	test aio-1.2 {seek start} -body {
	22	$f seek 2
	23	$f tell
	24	} -result {2}
	25
	26	test aio-1.3 {seek start} -body {
	27	$f seek 4 start
	28	$f tell
	29	} -result {4}
	30
	31	test aio-1.4 {read after seek} -body {
	32	set c [$f read 1]
	33	list $c [$f tell]
	34	} -result {- 5}
	35
	36	test aio-1.5 {seek backwards} -body {
	37	$f seek -2 current
	38	set c [$f read 1]
	39	list $c [$f tell]
	40	} -result {t 4}
	41
	42	test aio-1.6 {seek from end} -body {
	43	$f seek -2 end
	44	set c [$f read 2]
	45	list $c [$f tell]
	46	} -result [list "a\n" 10]
	47
	48	test aio-1.7 {seek usage} -body {
	49	$f seek 4 bad
	50	} -returnCodes error -match glob -result {wrong # args: should be "* seek offset ?start\|current\|end"}
	51
	52	test aio-1.8 {seek usage} -body {
	53	$f seek badint
	54	} -returnCodes error -match glob -result {expected integer but got "badint"}
	55
	56	test aio-1.9 {seek bad pos} -body {
	57	$f seek -20
	58	} -returnCodes error -match glob -result {testdata.in: Invalid argument}
	59
	60	test aio-2.1 {read usage} -body {
	61	$f read -nonoption
	62	} -returnCodes error -result {bad option "-nonoption": must be -nonewline, or -pending}
	63
	64	test aio-2.2 {read usage} -body {
	65	$f read badint
	66	} -returnCodes error -result {expected integer but got "badint"}
	67
	68	test aio-2.3 {read -ve len} -body {
	69	$f read " -20"
	70	} -returnCodes error -result {invalid parameter: negative len}
	71
	72	test aio-2.4 {read too many args} -body {
	73	$f read 20 extra
	74	} -returnCodes error -match glob -result {wrong # args: should be "* read ?-nonewline\|-pending\|len?"}
	75
	76	test aio-2.5 {read -pending on non-ssl} -body {
	77	$f read -pending
	78	} -returnCodes error -result {-pending not supported on this connection type}
	79
	80	test aio-3.1 {copy to invalid fh} -body {
	81	$f copy lambda
	82	} -returnCodes error -result {Not a filehandle: "lambda"}
	83
	84	test aio-3.2 {copy bad length} -body {
	85	$f copy stdout invalid
	86	} -returnCodes error -result {expected integer but got "invalid"}
	87
	88	set badvar a
	89
	90	test aio-4.1 {gets invalid var} -body {
	91	$f gets badvar(abc)
	92	} -returnCodes error -result {can't set "badvar(abc)": variable isn't array}
	93
	94	test aio-5.1 {puts usage} -body {
	95	stdout puts -badopt abc
	96	} -returnCodes error -result {wrong # args: should be "stdout puts ?-nonewline? str"}
	97
	98	test aio-6.1 {eof} {
	99	$f seek 0
	100	$f eof
	101	} {0}
	102
	103	test aio-6.2 {eof} {
	104	# eof won't trigger until we try to read
	105	$f seek 0 end
	106	$f eof
	107	} {0}
	108
	109	test aio-6.3 {eof} {
	110	$f read 1
	111	$f eof
	112	} {1}
	113
	114	test aio-7.1 {close args} -constraints socket -body {
	115	$f close badopt
	116	} -returnCodes error -result {bad option "badopt": must be -nodelete, r, or w}
	117
	118	test aio-7.2 {close w on non-socket} -constraints socket -body {
	119	$f close w
	120	} -returnCodes error -match regexp -result {^(Socket operation on non-socket\|Not a socket)$}
	121
	122	test aio-7.3 {close -nodelete on non-socket} -constraints socket -body {
	123	$f close -nodelete
	124	} -returnCodes error -result {not supported}
	125
	126	test aio-8.1 {filename} {
	127	$f filename
	128	} testdata.in
	129
	130	test aio-9.1 {open: posix modes} -constraints posixaio -body {
	131	set in [open testdata.in RDONLY]
	132	set buf [$in gets]
	133	$in close
	134	set buf
	135	} -result {test-data}
	136
	137	test aio-9.2 {open: posix modes, bad modes} -constraints posixaio -body {
	138	open testdata.in {CREAT TRUNC}
	139	} -returnCodes error -result {testdata.in: Invalid argument}
	140
	141	test aio-9.3 {open: posix modes, bad modes} -constraints posixaio -body {
	142	open testdata.in {WRONG TRUNC}
	143	} -returnCodes error -result {bad access mode "WRONG": must be APPEND, BINARY, CREAT, EXCL, NOCTTY, RDONLY, RDWR, TRUNC, or WRONLY}
	144
	145	test aio-9.4 {open: posix modes} -constraints posixaio -cleanup {
	146	file delete testdata.out
	147	} -body {
	148	set out [open testdata.out {WRONLY CREAT TRUNC}]
	149	$out puts write-data
	150	$out close
	151	# Now open for readwrite without truncate
	152	set io [open testdata.out {RDWR CREAT}]
	153	set buf [$io gets]
	154	$io close
	155	set buf
	156	} -result {write-data}
	157
	158	testreport

+27

-7

tests/alias.test less more

63	63
64	64	test curry-1.5 "Delete curry" references {
65	65	collect
	66	$one abc
66	67	unset one two
67	68	collect
68	69	} {2}

144	145	}
145	146	} 1
146	147
147		test statics-1.2 "static variable with invalid name" {
148		catch {
149		proc a {b} "{c\0d 4}" {
150		}
151		}
152		} 1
	148	test statics-1.2 "static variable with name containing null" {
	149	proc a {b} "{c\0d 4}" {
	150	return [set c\0d]
	151	}
	152	a 5
	153	} 4
153	154
154	155	test statics-1.3 "duplicate static variable" {
155	156	catch {

239	240	list [catch {upcall a} msg] $msg
240	241	} {1 {no previous command: "a"}}
241	242
242		test upcall-1.4 "upcall errors" {
	243	test upcall-1.5 "upcall errors" {
243	244	proc a {} {upcall a}
244	245	list [catch a msg] $msg
245	246	} {1 {no previous command: "a"}}
246	247
	248	test upcall-1.6 "delete local command" -setup {
	249	# First make sure a is gone
	250	rename a ""
	251	} -body {
	252	local proc a {x} {list 2 $x}
	253	# It is OK to rename this local proc
	254	rename a b
	255	b 5
	256	} -result {2 5} -cleanup {
	257	rename b ""
	258	}
	259
	260	test upcall-1.6 {delete local command with upcall} -body {
	261	local proc a {x} {list 2 $x}
	262	local proc a {x} {list 3 $x}
	263	# Can't rename a because it would invalide upcalls from a
	264	rename a c
	265	} -returnCodes error -result {can't rename local command "a"}
	266
247	267	testreport

+18

-0

tests/apply.test less more

126	126	apply [list {x {y 2} args} $applyBody] 1 3
127	127	} {{args {}} {x 1} {y 3}}
128	128
	129	test apply-9.1 {tailcall within apply} {
	130	proc p {y frame} {
	131	list [expr {$y * 2}] [expr {$frame - [info frame]}]
	132	}
	133	apply {{x} {
	134	tailcall p $x [info frame]
	135	notreached
	136	}} {4}
	137	} {8 0}
	138	test apply-9.2 {return from apply} {
	139	apply {{x} {
	140	return [expr {$x + 1}]
	141	}} {4}
	142	} {5}
	143
	144
	145	rename p {}
	146
129	147	::tcltest::cleanupTests
130	148	return
131	149

+21

-0

tests/applyns.test less more

87	87	set body {testApply}
88	88	apply [list args $body testApply]
89	89	} testApply
	90	test apply-7.9 {namespace access} {
	91	set ::testApply::x 0
	92	set body {testApply}
	93	apply [list args $body ::testApply]
	94	} testApply
	95
	96	# apply ignore the current namespace and runs at global scope
	97	# or the provided namespace (relative to global)
	98	test apply-8.1 {namespace current within apply} {
	99	namespace eval testApply {}
	100	namespace eval testApply2 {
	101	apply {a { return [namespace current]-$a } testApply} 5
	102	}
	103	} {::testApply-5}
	104
	105	test apply-8.2 {namespace current within apply} {
	106	namespace eval testApply2 {
	107	apply {a { return [namespace current]-$a }} 5
	108	}
	109	} {::-5}
90	110
91	111	namespace delete testApply
	112	namespace delete testApply2
92	113
93	114	testreport
94	115

+21

-1

tests/array.test less more

110	110
111	111	test array-1.20 "array stat" -body {
112	112	set output [array stat a]
113		regexp "1 entries in table.*number of buckets with 1 entries: 1" $output
	113	regexp "entries in table.*buckets" $output
114	114	} -result {1}
115	115
116	116	test array-1.21 "array stat non-array" -body {

130	130	array exists x
131	131	} -result {0}
132	132
	133	test array-2.1 {array -help} -constraints jim -body {
	134	array -help
	135	} -match glob -result {Usage: "array command ... ", where command is one of: *}
	136
	137	test array-2.2 {array -help get} -constraints jim -body {
	138	array -help get
	139	} -result {Usage: array get arrayName ?pattern?}
	140
	141	test array-2.3 {array -help ambiguous} -constraints jim -body {
	142	array -help s
	143	} -match glob -result {Usage: "array command ... ", where command is one of: *}
	144
	145	test array-2.3 {array -help nomatch} -constraints jim -body {
	146	array -help unknown
	147	} -match glob -result {Usage: "array command ... ", where command is one of: *}
	148
	149	test array-2.4 {array ambiguous} -constraints jim -body {
	150	array s
	151	} -returnCodes error -match glob -result {array, ambiguous command "s": should be *}
	152
133	153	testreport

+13

-13

tests/binary.test less more

250	250	test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
251	251	set a {0x50 0x51}
252	252	binary format c $a
253		} -result "expected integer but got \"0x50 0x51\""
	253	} -match glob -result "expected integer *but got \"0x50 0x51\""
254	254	test binary-8.11 {Tcl_BinaryObjCmd: format} {
255	255	set a {0x50 0x51}
256	256	binary format c1 $a

261	261	} -result {not enough arguments for all format specifiers}
262	262	test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
263	263	binary format s blat
264		} -result {expected integer but got "blat"}
	264	} -match glob -result {expected integer *but got "blat"}
265	265	test binary-9.3 {Tcl_BinaryObjCmd: format} {
266	266	binary format s0 0x50
267	267	} {}

289	289	test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
290	290	set a {0x50 0x51}
291	291	binary format s $a
292		} -result "expected integer but got \"0x50 0x51\""
	292	} -match glob -result "expected integer *but got \"0x50 0x51\""
293	293	test binary-9.12 {Tcl_BinaryObjCmd: format} {
294	294	set a {0x50 0x51}
295	295	binary format s1 $a

300	300	} -result {not enough arguments for all format specifiers}
301	301	test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
302	302	binary format S blat
303		} -result {expected integer but got "blat"}
	303	} -match glob -result {expected integer *but got "blat"}
304	304	test binary-10.3 {Tcl_BinaryObjCmd: format} {
305	305	binary format S0 0x50
306	306	} {}

328	328	test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
329	329	set a {0x50 0x51}
330	330	binary format S $a
331		} -result "expected integer but got \"0x50 0x51\""
	331	} -match glob -result "expected integer *but got \"0x50 0x51\""
332	332	test binary-10.12 {Tcl_BinaryObjCmd: format} {
333	333	set a {0x50 0x51}
334	334	binary format S1 $a

339	339	} -result {not enough arguments for all format specifiers}
340	340	test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
341	341	binary format i blat
342		} -result {expected integer but got "blat"}
	342	} -match glob -result {expected integer *but got "blat"}
343	343	test binary-11.3 {Tcl_BinaryObjCmd: format} {
344	344	binary format i0 0x50
345	345	} {}

370	370	test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
371	371	set a {0x50 0x51}
372	372	binary format i $a
373		} -result "expected integer but got \"0x50 0x51\""
	373	} -match glob -result "expected integer *but got \"0x50 0x51\""
374	374	test binary-11.13 {Tcl_BinaryObjCmd: format} {
375	375	set a {0x50 0x51}
376	376	binary format i1 $a

381	381	} -result {not enough arguments for all format specifiers}
382	382	test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
383	383	binary format I blat
384		} -result {expected integer but got "blat"}
	384	} -match glob -result {expected integer *but got "blat"}
385	385	test binary-12.3 {Tcl_BinaryObjCmd: format} {
386	386	binary format I0 0x50
387	387	} {}

412	412	test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
413	413	set a {0x50 0x51}
414	414	binary format I $a
415		} -result "expected integer but got \"0x50 0x51\""
	415	} -match glob -result "expected integer *but got \"0x50 0x51\""
416	416	test binary-12.13 {Tcl_BinaryObjCmd: format} {
417	417	set a {0x50 0x51}
418	418	binary format I1 $a

1663	1663	} -result {not enough arguments for all format specifiers}
1664	1664	test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
1665	1665	binary format t blat
1666		} -result {expected integer but got "blat"}
	1666	} -match glob -result {expected integer *but got "blat"}
1667	1667	test binary-48.3 {Tcl_BinaryObjCmd: format} {
1668	1668	binary format S0 0x50
1669	1669	} {}

1709	1709	test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
1710	1710	set a {0x50 0x51}
1711	1711	binary format t $a
1712		} -result "expected integer but got \"0x50 0x51\""
	1712	} -match glob -result "expected integer *but got \"0x50 0x51\""
1713	1713	test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian {
1714	1714	set a {0x50 0x51}
1715	1715	binary format t1 $a

1725	1725	} -result {not enough arguments for all format specifiers}
1726	1726	test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
1727	1727	binary format n blat
1728		} -result {expected integer but got "blat"}
	1728	} -match glob -result {expected integer *but got "blat"}
1729	1729	test binary-49.3 {Tcl_BinaryObjCmd: format} {
1730	1730	binary format n0 0x50
1731	1731	} {}

1756	1756	test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
1757	1757	set a {0x50 0x51}
1758	1758	binary format n $a
1759		} -result "expected integer but got \"0x50 0x51\""
	1759	} -match glob -result "expected integer *but got \"0x50 0x51\""
1760	1760	test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian {
1761	1761	set a {0x50 0x51}
1762	1762	binary format n1 $a

+28

-0

tests/certificate.pem less more

	0	-----BEGIN CERTIFICATE-----
	1	MIIEwDCCAqgCCQCFOs3gH4RsKTANBgkqhkiG9w0BAQUFADAiMQswCQYDVQQGEwJh
	2	dTETMBEGA1UEAwwKamltLnRjbC50azAeFw0xOTA5MjQyMzQ2NDFaFw00NzAyMDgy
	3	MzQ2NDFaMCIxCzAJBgNVBAYTAmF1MRMwEQYDVQQDDApqaW0udGNsLnRrMIICIjAN
	4	BgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEA0T9HMb5b2WZDIAF7+7KZzwAEiXC5
	5	misVrY1gmlwvLlSVx1pXKx5KrFpwkBMfDs1Zsi03/D46N+kViOmSJY/h5nxpiTdb
	6	s1Gld2b1RqFbnXcLmx7eWVXXouLDcmzoJM1Y7vh26e9j3Uy4Bsew7zfxgnWmbfOA
	7	9Sg/rHamQFfJ+Ov9NglkAoGPwdIiDWc4+hkKD6HL3B72m3VyD4crDSuTm2vFqUDh
	8	Xk+Jw3clNQYXHQrOSpDKst1qPQtEDTQbrmKhSN6jMBRwcwfo39lCZLN02jEfOC2b
	9	wHPe+VgcyfCzWgfKHtPlhqqanSIndDSAc6aF5hzI1vlT2dZNmSWDZ6QBrwharh25
	10	QXcnQhDr/9DyHIjgvojROsOiSaT4pVvJRBsVm7N/7kVQKvNdbwB8itz+ubLlb5SY
	11	ahlZNBMpE9RqgchwAwe0SpjILMBHI90/H89SrZPZ4rMitZiIq5/3mBFEy/7Xio/G
	12	5jw/Gp3cHa6SMf/6cqhll7binB8s8Yd5c8RvdNunczCobKmbnTMDRdsnjnvWFmia
	13	PJZUdcOtftxUCxYP2tEjapQL8kjC+K4MjCGkde/5lrd8+yRY6GK6zixxfYb1jka/
	14	NFdXBaws4gm8amrsFstkY3K2GqrVh44/sG7BNqsl4hxkqyHryay7B413+KUrkiET
	15	4PqwSHgtJHPayAMCAwEAATANBgkqhkiG9w0BAQUFAAOCAgEAlieZi6YNBCKkCLVP
	16	bIEtB/Ky28YTZ8Blv9dyOG557nfIze0NgsFJLOvLCFqKh8TKJRxGWkBeDh72ozjd
	17	R0twQ9w/uWv/RIvBvX+O67ByN8/u3E+H8TqsnRq6FxnHLKh4MbUuNya6/dskVAtB
	18	5JthL5EPU0z+6MqIissmx4V7d/MA3bEWF+etAnI9maxdJ2KXlqiBy0K09RCydZzi
	19	JHSVqpY/UrwYjWxgJgMFq5ZLrMwLv2SVqFa5FnMsP2Qc1Ojgq0Jz8vbYFd9CCyyc
	20	mZUb1fAoxKRjBOBbbgW3fYsS4MkJ1PGeUh+60beDsKZhuTe5g5KCiB0QdB53Juth
	21	UizaqM+u2PECDV5TmhVIDCyHhGbbfzIFppsrpCZfXwtie4qqj50l55I7KoX6Twhu
	22	7uadSWRiU60aOD7m99SUkqqkODXy2BvQixKZ6QOruTMqgbbpxpVMOUxFPkkmB5Jk
	23	LQ+3uIjBbVKQxGzniVwYwIRCTgg1x/nTlHEr5DhEs/8MiFrw3UafX9B6m9Jo1oJh
	24	HAs01bC9yMqNhaTXZRrGR4hEM3cmS0Sa6VYiZ+dhDwucvBwz0ClSiTT3iFjGcTMZ
	25	r9m5x0V15qZSvj1GWp6hSWIG/NwS+4gvv75Jlx83cr+bTlHgDl8h4seEmj8HhPq1
	26	j9ZXBr9P2ETiD8OVyZAT3hhSwOg=
	27	-----END CERTIFICATE-----

+42

-0

tests/clock.test less more

29	29	clock format foo
30	30	} -returnCodes error -result {expected integer but got "foo"}
31	31
	32	test clock-3.7 {clock format tests} -body {
	33	clock format 10000 -format [string repeat x 1000] -gmt true
	34	} -returnCodes error -result {format string too long or invalid time}
	35
32	36	test clock-3.8 {clock format tests} -body {
33	37	clock format a b c d e g
34	38	} -returnCodes error -result {wrong # args: should be "clock format seconds ?-format string? ?-gmt boolean?"}

46	50	clock format 123 -format "x"
47	51	} x
48	52
	53	test clock-3.12 {clock format tests} -body {
	54	clock format 123 -gmt blah
	55	} -returnCodes error -result {expected boolean but got "blah"}
	56
	57	test clock-3.13 {clock format tests} -body {
	58	clock format 123 odd option count
	59	} -returnCodes error -result {wrong # args: should be "clock format seconds ?-format string? ?-gmt boolean?"}
	60
49	61	test clock-4.1 {clock scan tests} clockscan {
50	62	clock scan {Sun Nov 04 03:02:46 AM 1990} -format {%a %b %d %I:%M:%S %p %Y} -gmt true
51	63	} 657687766
52	64
	65	test clock-4.2 {clock scan tests} -constraints clockscan -body {
	66	clock scan odd number arg count
	67	} -returnCodes error -result {wrong # args: should be "clock scan str -format format ?-gmt boolean?"}
	68
	69	test clock-4.3 {clock scan tests} -constraints clockscan -body {
	70	clock scan str -bad option
	71	} -returnCodes error -result {bad option "-bad": must be -format, or -gmt}
	72
	73	test clock-4.4 {clock scan tests} -constraints clockscan -body {
	74	clock scan str -gmt true
	75	} -returnCodes error -result {wrong # args: should be "clock scan str -format format ?-gmt boolean?"}
	76
	77	test clock-4.5 {clock scan tests} -constraints clockscan -body {
	78	clock scan str -format "%H" -gmt true
	79	} -returnCodes error -result {Failed to parse time according to format}
	80
	81	test clock-5.1 {clock seconds} {
	82	clock format [clock seconds]
	83	list 1
	84	} {1}
	85
	86	test clock-5.2 {clock millis, micros} {
	87	set ms [clock millis]
	88	set us [clock micros]
	89	set delta [expr {abs($us - $ms * 1000)}]
	90	if {$delta > 250000} {
	91	error "clock millis and micros differ by too much"
	92	}
	93	} {}
	94
53	95	testreport

+250

-0

tests/coverage.test less more

	0	# various tests to improve code coverage
	1
	2	source [file dirname [info script]]/testing.tcl
	3
	4	testCmdConstraints getref rand namespace
	5
	6	testConstraint debug-invstr 0
	7	catch {
	8	debug -commands
	9	testConstraint debug-invstr 1
	10	}
	11
	12	test dupobj-1 {duplicate script object} {
	13	set y {expr 2}
	14	# make y a script
	15	eval $y
	16	# Now treat it as a list that needs duplicating
	17	lset y 0 abc
	18	set y
	19	} {abc 2}
	20
	21	test dupobj-2 {duplicate expr object} {
	22	set y {2 + 1}
	23	# make y an expression
	24	expr $y
	25	# Now treat it as a list that needs duplicating
	26	lset y 0 abc
	27	set y
	28	} {abc + 1}
	29
	30	test dupobj-3 {duplicate interpolated object} namespace {
	31	set w 4
	32	set y def($w)
	33	# Now treat it as a namespace object that needs duplicating
	34	namespace eval $y {}
	35	apply [list x {set x 1} $y] x
	36	} {1}
	37
	38	test dupobj-4 {duplicate dict subst object} namespace {
	39	# make y a dict subst
	40	set def(4) 5
	41	set y def(4)
	42	incr $y
	43	# Now treat it as a namespace object that needs duplicating
	44	namespace eval $y {}
	45	apply [list x {set x 1} $y] x
	46	} {1}
	47
	48	test dupobj-5 {duplicate object with no string rep} namespace {
	49	# A sorted list has no string rep
	50	set y [lsort {abc def}]
	51	# Now treat it as a namespace object that needs duplicating
	52	namespace eval $y {}
	53	apply [list x {set x 1} $y] x
	54	} {1}
	55
	56	test dupobj-6 {duplicate object with no type dup proc} namespace {
	57	set x 6
	58	incr x
	59	# x is now an int, an object with no dup proc
	60	# using as a namespace requires the object to be duplicated
	61	namespace eval $x {
	62	proc a {} {}
	63	rename a ""
	64	}
	65	} {}
	66
	67	test dupobj-7 {duplicate scan obj} namespace {
	68	set x "%d %d"
	69	scan "1 4" $x y z
	70	# Now treat it as a namespace object that needs duplicating
	71	namespace eval $x {}
	72	apply [list x {set x 1} $x] x
	73	} {1}
	74
	75
	76	test script-1 {convert empty object to script} {
	77	set empty [foreach a {} {}]
	78	eval $empty
	79	} {}
	80
	81	test ref-1 {treat something as a reference} getref {
	82	set ref [ref abc tag]
	83	append ref " "
	84	getref " $ref "
	85	} {abc}
	86
	87	test ref-2 {getref invalid reference} -constraints getref -body {
	88	getref "<reference.<tag____>.99999999999999000000>"
	89	} -returnCodes error -match glob -result {invalid reference id *}
	90
	91	test ref-3 {getref invalid reference tag} -constraints getref -body {
	92	getref "<reference.<tag!%(*>.99999999999999000000>"
	93	} -returnCodes error -match glob -result {expected reference but got "<reference.<tag!%(*>.99999999999999000000>"}
	94
	95	test ref-4 {finalize} getref {
	96	finalize $ref
	97	} {}
	98
	99	test ref-5 {finalize} getref {
	100	finalize $ref cleanup
	101	finalize $ref cleanup2
	102	finalize $ref
	103	} {cleanup2}
	104
	105	test ref-6 {finalize get invalid reference} -constraints getref -body {
	106	finalize "<reference.<tag____>.99999999999999000000>"
	107	} -returnCodes error -match glob -result {invalid reference id *}
	108
	109	test ref-7 {finalize set invalid reference} -constraints getref -body {
	110	finalize "<reference.<tag____>.99999999999999000000>" cleanup
	111	} -returnCodes error -match glob -result {invalid reference id *}
	112
	113	test collect-1 {recursive collect} getref {
	114	set ref2 [ref dummy cleanup2]
	115	unset ref2
	116	proc cleanup2 {ref value} {
	117	# Try to call collect
	118	stdout puts "in cleanup2: ref=$ref, value=$value"
	119	if {[collect]} {
	120	error "Should return 0"
	121	}
	122	}
	123	collect
	124	} {1}
	125
	126	test scan-1 {update string of scan obj} debug-invstr {
	127	set x "%d %d"
	128	scan "1 4" $x y z
	129	debug invstr $x
	130	# x is now of scanfmt type with no string rep
	131	set x
	132	} {%d %d}
	133
	134	# It is too hard to do this one without debug invstr
	135	test index-1 {update string of index} debug-invstr {
	136	set x end-1
	137	lindex {a b c} $x
	138	debug invstr $x
	139	# x is now of index type with no string rep
	140	set x
	141	} {end-1}
	142
	143	test index-2 {update string of index} debug-invstr {
	144	set x end
	145	lindex {a b c} $x
	146	debug invstr $x
	147	# x is now of index type with no string rep
	148	set x
	149	} {end}
	150
	151	test index-3 {update string of index} debug-invstr {
	152	set x 2
	153	lindex {a b c} $x
	154	debug invstr $x
	155	# x is now of index type with no string rep
	156	set x
	157	} {2}
	158
	159	test index-4 {index > INT_MAX} debug-invstr {
	160	set x 99999999999
	161	incr x
	162	# x is now of int type > INT_MAX
	163	lindex {a b c} $x
	164	} {}
	165
	166	test index-5 {update string of index} debug-invstr {
	167	set x -1
	168	lindex {a b c} $x
	169	debug invstr $x
	170	# x is now of index type with no string rep
	171	set x
	172	} {-2147483647}
	173
	174	test cmd-1 {standard -commands} jim {
	175	expr {"length" in [string -commands]}
	176	} {1}
	177
	178	test rand-1 {rand} -constraints rand -body {
	179	rand 1 2 3
	180	} -returnCodes error -result {wrong # args: should be "rand ?min? max"}
	181
	182	test rand-2 {rand} -constraints rand -body {
	183	rand foo
	184	} -returnCodes error -match glob -result {expected integer *but got "foo"}
	185
	186	test rand-3 {rand} -constraints rand -body {
	187	rand 2 bar
	188	} -returnCodes error -match glob -result {expected integer *but got "bar"}
	189
	190	test rand-4 {rand} rand {
	191	string is integer [rand]
	192	} {1}
	193
	194	test rand-5 {srand} rand {
	195	set x [expr {srand(123)}]
	196	if {$x >= 0 && $x <= 1} {
	197	return 1
	198	} else {
	199	return 0
	200	}
	201	} {1}
	202
	203	test lreverse-1 {lreverse} -body {
	204	lreverse
	205	} -returnCodes error -result {wrong # args: should be "lreverse list"}
	206
	207	test divide-1 {expr} -constraints jim -body {
	208	/ 2 0
	209	} -returnCodes error -result {Division by zero}
	210
	211	test variable-1 {upvar, name with embedded null} -constraints jim -body {
	212	proc a {} {
	213	upvar var\0null abc
	214	incr abc
	215	}
	216	set var\0null 2
	217	a
	218	} -returnCodes ok -result {3}
	219
	220	test variable-2 {upvar to global name} {
	221	set ::globalvar 1
	222	proc a {} {
	223	upvar ::globalvar abc
	224	incr abc
	225	}
	226	a
	227	} {2}
	228
	229	test unknown-1 {recursive unknown} -body {
	230	# unknown will call itself a maximum of 50 times before simply returning an error
	231	proc unknown {args} {
	232	nonexistent 3
	233	}
	234	nonexistent 4
	235	} -returnCodes error -result {invalid command name "nonexistent"} -cleanup {
	236	rename unknown {}
	237	}
	238
	239	test interpolate-1 {interpolate} -body {
	240	unset -nocomplain a
	241	for {set i 0} {$i < 10} {incr i} {
	242	set a($i) $i
	243	}
	244	set x "$a(0)$a(1)$a(2)$a(3)$a(4)$a(5)$a(6)$a(7)$a(8)$a(9)$nonexistent"
	245	set x
	246	} -returnCodes error -result {can't read "nonexistent": no such variable}
	247
	248
	249	testreport

+109

-0

tests/debug.test less more

	0	source [file dirname [info script]]/testing.tcl
	1	needs cmd debug
	2
	3	set x 0
	4
	5	test debug-0.1 {debug too few args} -body {
	6	debug
	7	} -returnCodes error -result {wrong # args: should be "debug subcommand ?...?"}
	8
	9	test debug-0.2 {debug bad option} -body {
	10	debug badoption
	11	} -returnCodes error -result {bad subcommand "badoption": must be exprbc, exprlen, invstr, objcount, objects, refcount, scriptlen, or show}
	12
	13	test debug-1.1 {debug refcount too few args} -body {
	14	debug refcount
	15	} -returnCodes error -result {wrong # args: should be "debug refcount object"}
	16
	17	test debug-1.2 {debug refcount test} -body {
	18	debug refcount x
	19	} -result {2}
	20
	21	test debug-1.3 {debug refcount too many args} -body {
	22	debug refcount a b c
	23	} -returnCodes error -result {wrong # args: should be "debug refcount object"}
	24
	25	test debug-2.1 {debug objcount} -body {
	26	regexp {free \d+ used \d+} [debug objcount]
	27	} -result {1}
	28
	29	test debug-2.2 {debug objcount too many args} -body {
	30	debug objcount a b c
	31	} -returnCodes error -result {wrong # args: should be "debug objcount"}
	32
	33	test debug-3.1 {debug objects} -body {
	34	expr {[llength [debug objects]] > 1000}
	35	} -result {1}
	36
	37	# does not currently check for too many args
	38	test debug-3.2 {debug objects too many args} -body {
	39	debug objects a b c
	40	} -returnCodes error -result {wrong # args: should be "debug objects"}
	41
	42	test debug-4.1 {debug invstr too few args} -body {
	43	debug invstr
	44	} -returnCodes error -result {wrong # args: should be "debug invstr object"}
	45
	46	test debug-4.2 {debug invstr} -body {
	47	debug invstr x
	48	} -result {}
	49
	50	test debug-4.3 {debug invstr too many args} -body {
	51	debug invstr a b c
	52	} -returnCodes error -result {wrong # args: should be "debug invstr object"}
	53
	54	test debug-5.1 {debug scriptlen too few args} -body {
	55	debug scriptlen
	56	} -returnCodes error -result {wrong # args: should be "debug scriptlen script"}
	57
	58	test debug-5.2 {debug scriptlen} -body {
	59	debug scriptlen {puts "hello world"}
	60	} -result {3}
	61
	62	test debug-5.3 {debug scriptlen too many args} -body {
	63	debug scriptlen a b c
	64	} -returnCodes error -result {wrong # args: should be "debug scriptlen script"}
	65
	66	test debug-6.1 {debug exprlen too few args} -body {
	67	debug exprlen
	68	} -returnCodes error -result {wrong # args: should be "debug exprlen expression"}
	69
	70	test debug-6.2 {debug exprlen} -body {
	71	debug exprlen { $x + 10 }
	72	} -result {3}
	73
	74	test debug-6.3 {debug exprlen too many args} -body {
	75	debug exprlen a b c
	76	} -returnCodes error -result {wrong # args: should be "debug exprlen expression"}
	77
	78	test debug-7.1 {debug exprbc too few args} -body {
	79	debug exprbc
	80	} -returnCodes error -result {wrong # args: should be "debug exprbc expression"}
	81
	82	test debug-7.2 {debug exprbc} -body {
	83	set y [dict create]
	84	dict set y z 1
	85	debug exprbc { $x + 10 + 1.5 + true + [llength {{1} {2}}] + "5" + $y(z) + "\x33"}
	86	} -result {+ {+ {+ {+ {+ {+ {+ {VAR x} {INT 10}} {DBL 1.5}} {BOO true}} {CMD {llength {{1} {2}}}}} {STR 5}} {ARY y(z)}} {ESC {\x33}}}
	87
	88	test debug-7.4 {debug exprbc too many args} -body {
	89	debug exprbc a b c
	90	} -returnCodes error -result {wrong # args: should be "debug exprbc expression"}
	91
	92	test debug-8.1 {debug show too few args} -body {
	93	debug show
	94	} -returnCodes error -result {wrong # args: should be "debug show object"}
	95
	96	test debug-8.1 {debug show} -body {
	97	set x hello
	98	lappend x there
	99	debug show $x
	100	} -result {refcount: 2, type: list
	101	chars (11): <<hello there>>
	102	bytes (11): 68 65 6c 6c 6f 20 74 68 65 72 65}
	103
	104	test debug-8.3 {debug show too many args} -body {
	105	debug show a b c
	106	} -returnCodes error -result {wrong # args: should be "debug show object"}
	107
	108	testreport

+143

-0

tests/dict.test less more

248	248	llength $a
249	249	} 12
250	250
	251	# As of 0.79, dicts maintain insertion order
	252	test dict-25.1 {dict ordering} {
	253	dict keys {a x 0 y}
	254	} {a 0}
	255
	256	test dict-25.2 {dict ordering} {
	257	dict keys {0 x a y}
	258	} {0 a}
	259
	260	test dict-25.3 {dict ordering} {
	261	set d [dict create a y 0 x 2 z]
	262	dict set d 1 w
	263	dict keys $d
	264	} {a 0 2 1}
	265
	266	test dict-25.3 {dict ordering} {
	267	set d [dict create a y 0 x 2 z]
	268	dict set d 0 w
	269	dict keys $d
	270	} {a 0 2}
	271
	272	test dict-25.4 {removal of keys that hash earlier} {
	273	set parsed {formPost {text {This is text.} {text file} Hello. {image file} abc}}
	274
	275	dict unset parsed formPost text
	276	dict unset parsed formPost {image file}
	277	dict get $parsed formPost {text file}
	278	} Hello.
	279
	280	test dict-25.5 {list to dict, duplicate keys} {
	281	set l [list a 1 a 2 a 3]
	282	# make sure there is no string rep
	283	lappend l b 4
	284	dict get $l a
	285	} {3}
	286
	287	# Follow Tcl, to force interpretation, not compilation.
	288	# No effect in Jim
	289	set dict dict
	290	test dict-26.1 {dict getdef command} -body {
	291	dict getdef {a b} a c
	292	} -result b
	293	test dict-26.2 {dict getdef command} -body {
	294	dict getdef {a b} b c
	295	} -result c
	296	test dict-26.3 {dict getdef command} -body {
	297	dict getdef {a {b c}} a b d
	298	} -result c
	299	test dict-26.4 {dict getdef command} -body {
	300	dict getdef {a {b c}} a c d
	301	} -result d
	302	test dict-26.5 {dict getdef command} -body {
	303	dict getdef {a {b c}} b c d
	304	} -result d
	305	test dict-26.6 {dict getdef command} -returnCodes error -body {
	306	dict getdef {a {b c d}} a b d
	307	} -result {missing value to go with key}
	308	test dict-26.7 {dict getdef command} -returnCodes error -body {
	309	dict getdef
	310	} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
	311	test dict-26.8 {dict getdef command} -returnCodes error -body {
	312	dict getdef {}
	313	} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
	314	test dict-26.9 {dict getdef command} -returnCodes error -body {
	315	dict getdef {} {}
	316	} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
	317	test dict-26.10 {dict getdef command} -returnCodes error -body {
	318	dict getdef {a b c} d e
	319	} -result {missing value to go with key}
	320	test dict-26.11 {dict getdef command} -body {
	321	$dict getdef {a b} a c
	322	} -result b
	323	test dict-26.12 {dict getdef command} -body {
	324	$dict getdef {a b} b c
	325	} -result c
	326	test dict-26.13 {dict getdef command} -body {
	327	$dict getdef {a {b c}} a b d
	328	} -result c
	329	test dict-26.14 {dict getdef command} -body {
	330	$dict getdef {a {b c}} a c d
	331	} -result d
	332	test dict-26.15 {dict getdef command} -body {
	333	$dict getdef {a {b c}} b c d
	334	} -result d
	335	test dict-26.16 {dict getdef command} -returnCodes error -body {
	336	$dict getdef {a {b c d}} a b d
	337	} -result {missing value to go with key}
	338	test dict-26.17 {dict getdef command} -returnCodes error -body {
	339	$dict getdef {a b c} d e
	340	} -result {missing value to go with key}
	341
	342	test dict-27.1 {dict getwithdefault command} -body {
	343	dict getwithdefault {a b} a c
	344	} -result b
	345	test dict-27.2 {dict getwithdefault command} -body {
	346	dict getwithdefault {a b} b c
	347	} -result c
	348	test dict-27.3 {dict getwithdefault command} -body {
	349	dict getwithdefault {a {b c}} a b d
	350	} -result c
	351	test dict-27.4 {dict getwithdefault command} -body {
	352	dict getwithdefault {a {b c}} a c d
	353	} -result d
	354	test dict-27.5 {dict getwithdefault command} -body {
	355	dict getwithdefault {a {b c}} b c d
	356	} -result d
	357	test dict-27.6 {dict getwithdefault command} -returnCodes error -body {
	358	dict getwithdefault {a {b c d}} a b d
	359	} -result {missing value to go with key}
	360	test dict-27.7 {dict getwithdefault command} -returnCodes error -body {
	361	dict getwithdefault
	362	} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
	363	test dict-27.8 {dict getwithdefault command} -returnCodes error -body {
	364	dict getwithdefault {}
	365	} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
	366	test dict-27.9 {dict getwithdefault command} -returnCodes error -body {
	367	dict getwithdefault {} {}
	368	} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
	369	test dict-27.10 {dict getdef command} -returnCodes error -body {
	370	dict getwithdefault {a b c} d e
	371	} -result {missing value to go with key}
	372	test dict-27.11 {dict getwithdefault command} -body {
	373	$dict getwithdefault {a b} a c
	374	} -result b
	375	test dict-27.12 {dict getwithdefault command} -body {
	376	$dict getwithdefault {a b} b c
	377	} -result c
	378	test dict-27.13 {dict getwithdefault command} -body {
	379	$dict getwithdefault {a {b c}} a b d
	380	} -result c
	381	test dict-27.14 {dict getwithdefault command} -body {
	382	$dict getwithdefault {a {b c}} a c d
	383	} -result d
	384	test dict-27.15 {dict getwithdefault command} -body {
	385	$dict getwithdefault {a {b c}} b c d
	386	} -result d
	387	test dict-27.16 {dict getwithdefault command} -returnCodes error -body {
	388	$dict getwithdefault {a {b c d}} a b d
	389	} -result {missing value to go with key}
	390	test dict-27.17 {dict getdef command} -returnCodes error -body {
	391	$dict getwithdefault {a b c} d e
	392	} -result {missing value to go with key}
	393
251	394	testreport

+32

-3

tests/dict2.test less more

94	94	test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b
95	95	test dict-3.12 {dict get command} -returnCodes error -body {
96	96	dict get
97		} -result {wrong # args: should be "dict get dictionary ?key ...?"}
	97	} -match glob -result {wrong # args: should be "dict get dictionary ?key*?"}
98	98	test dict-3.13 {dict get command} -body {
99	99	set dict [dict get {a b c d}]
100	100	if {$dict eq "a b c d"} {

315	315	dict-sort $dictv
316	316	} -cleanup {
317	317	unset dictv
318		} -result {expected integer but got "dummy"}
	318	} -match glob -result {expected integer *but got "dummy"}
319	319	test dict-11.10 {dict incr command} -returnCodes error -body {
320	320	set dictv {a 1}
321	321	dict incr dictv a dummy
322	322	dict-sort $dictv
323	323	} -cleanup {
324	324	unset dictv
325		} -result {expected integer but got "dummy"}
	325	} -match glob -result {expected integer *but got "dummy"}
326	326	test dict-11.11 {dict incr command} -setup {
327	327	unset -nocomplain dictv
328	328	} -body {

1249	1249	} -cleanup {
1250	1250	unset foo t inner
1251	1251	} -result OK
	1252
	1253	set dictnulls {ab\0c de\0f \0ghi kl\0m}
	1254	set dictgood [array get tcl_platform]
	1255	set dictbad {abc def ghi}
	1256
	1257	test dict-23.1 {dict info} {
	1258	regexp {entries in table,.*buckets} [dict info $dictgood]
	1259	} {1}
	1260
	1261	test dict-23.2 {dict info usage} -body {
	1262	dict info
	1263	} -returnCodes error -result {wrong # args: should be "dict info dictionary"}
	1264
	1265	test dict-23.3 {dict info baddict} -body {
	1266	dict info $dictbad
	1267	} -returnCodes error -result {missing value to go with key}
	1268
	1269	test dict-23.4 {dict with usage} -body {
	1270	dict with
	1271	} -returnCodes error -result {wrong # args: should be "dict with dictVar ?key ...? script"}
	1272
	1273	test dict-23.5 {dict with badvar} -constraints jim -body {
	1274	dict with dictnulls {lsort [info locals]}
	1275	} -returnCodes ok -result [list ab\0c de\0f \0ghi kl\0m]
	1276
	1277	test dict-23.6 {dict with baddict} -body {
	1278	dict with dictbad {}
	1279	} -returnCodes error -result {missing value to go with key}
	1280
1252	1281
1253	1282	testreport

-4

tests/error.test less more

14	14	set rc [catch {b} msg]
15	15	#puts stderr "error-1.1\n[errorInfo $msg]\n"
16	16
17		list $rc $msg [info stacktrace]
	17	list $rc $msg [basename-stacktrace [info stacktrace]]
18	18	} {1 {error thrown from a} {{} error.test 4 a error.test 8 b error.test 15}}
19	19
20	20	proc c {} {

43	43	# Now rethrow with the new stack
44	44	set rc [catch {error $msg $newst} msg]
45	45	#puts [errorInfo $msg]
46		info stacktrace
	46	basename-stacktrace [info stacktrace]
47	47	} {{} error.test 4 a error.test 22 c error.test 26 e error.test 34}
48	48
49	49	# Package should be able to invoke exit, which should exit if not caught
50	50	test error-2.1 "Exit from package" {
51		list [catch -exit {package require exitpackage} msg] $msg
52		} {6 {Can't load package exitpackage}}
	51	catch -exit {package require exitpackage} msg
	52	} 6
53	53
54	54	testreport

-1

tests/errors.tcl less more

20	20	package require dummy
21	21	}
22	22	source {
23		source dummy.tcl
	23	source [file dirname [info script]]/dummy.tcl
24	24	}
25	25	badpackage {
26	26	package require bogus

+32

-4

tests/event.test less more

79	79	update
80	80	set errRes;
81	81	} err1
	82
	83	# Tcl handles errors in bgerror slightly differently
	84	# Jim prints the original error to stderr
	85	test event-7.4 {bgerror throws an error} -constraints jim -body {
	86	exec [info nameofexecutable] - << {
	87	proc bgerror {err} {
	88	error "inside bgerror"
	89	}
	90	after 0 {error err1}
	91	update
	92	}
	93	} -result {stdin:3: Error: inside bgerror
	94	at file "stdin", line 3}
82	95
83	96	# end of bgerror tests
84	97	catch {rename bgerror {}}

184	197	foreach i [after info] {
185	198	after cancel $i
186	199	}
187		after 10; update; # On Mac make sure update won't take long
188		after 200 {set x x-done}
189		after 400 {set y y-done}
	200	after 20; update; # On Mac make sure update won't take long
	201	after 400 {set x x-done}
	202	after 800 {set y y-done}
190	203	after idle {set z z-done}
191	204	set x before
192	205	set y before
193	206	set z before
194		after 300
	207	after 600
195	208	update
196	209	list $x $y $z
197	210	} {x-done before z-done}

211	224	} msg] $msg
212	225	} {5 SIGALRM}
213	226
	227	test event-13.2 {after info invalid} -body {
	228	after info not-a-valid-id
	229	} -returnCodes error -result {event "not-a-valid-id" doesn't exist}
	230
	231	test event-13.3 {after info noexist} -body {
	232	after info after#99999999
	233	} -returnCodes error -result {event "after#99999999" doesn't exist}
	234
	235	test event-13.4 {after info usage} -body {
	236	after info too-many args
	237	} -returnCodes error -result {wrong # args: should be "after info ?id?"}
	238
	239	test event-13.5 {after cancel noexist} {
	240	after cancel after#99999999
	241	} {}
214	242
215	243	test event-14.1 {socket stream.server client address} {jim socket} {
216	244	set s1 [socket stream.server 5001]

-2

tests/exec.test less more

16	16
17	17	needs cmd exec
18	18	needs cmd flush
	19
	20	# Jim needs [pipe] to implement [open \|command]
	21	if {[testConstraint tcl]} {
	22	testConstraint pipe 1
	23	} else {
	24	testCmdConstraints pipe
	25	}
19	26
20	27	testConstraint unix [expr {$tcl_platform(platform) eq {unix}}]
21	28

414	421
415	422	test exec-17.1 {redirecting from command pipeline} -setup {
416	423	makeFile "abc\nghi\njkl" gorp.file
417		} -body {
	424	} -constraints pipe -body {
418	425	set f [open "\|cat gorp.file \| wc -l" r]
419	426	set result [lindex [exec cat <@$f] 0]
420	427	close $f

425	432
426	433	test exec-17.2 {redirecting to command pipeline} -setup {
427	434	makeFile "abc\nghi\njkl" gorp.file
428		} -body {
	435	} -constraints pipe -body {
429	436	set f [open "\|wc -l >gorp2.file" w]
430	437	exec cat gorp.file >@$f
431	438	flush $f

+75

-4

tests/exec2.test less more

4	4	source [file dirname [info script]]/testing.tcl
5	5
6	6	needs cmd exec
7		foreach i {pipe signal wait} {
8		testConstraint $i [expr {[info commands $i] ne ""}]
	7	testCmdConstraints signal wait alarm after
	8
	9	# Jim needs [pipe] to implement [open \|command]
	10	if {[testConstraint tcl]} {
	11	testConstraint pipe 1
	12	} else {
	13	testCmdConstraints pipe
9	14	}
	15
10	16	# Some Windows platforms (e.g. AppVeyor) produce ENOSPC rather than killing
11	17	# the child with SIGPIPE). So turn off this test for that platform
12	18	if {[info exists env(MSYSTEM)] && $env(MSYSTEM) eq "MINGW32"} {

53	59
54	60	array set env [array get saveenv]
55	61
56		test exec2-3.1 "close pipeline return value" {
	62	test exec2-3.1 "close pipeline return value" pipe {
57	63	set f [open \|false]
58	64	set rc [catch {close $f} msg opts]
59	65	lassign [dict get $opts -errorcode] status pid exitcode
60	66	list $rc $msg $status $exitcode
61	67	} {1 {child process exited abnormally} CHILDSTATUS 1}
62	68
63		test exec2-3.2 "close pipeline return value" -constraints {pipe nomingw32} -body {
	69	test exec2-3.2 "close pipeline return value" -constraints {jim pipe nomingw32} -body {
64	70	# Create a pipe and immediately close the read end
65	71	lassign [pipe] r w
66	72	close $r

99	105	}
100	106	} -result {CHILDSTATUS 0}
101	107
	108	test exec2-4.1 {redirect from invalid filehandle} -body {
	109	exec cat <@bogus
	110	} -returnCodes error -match glob -result {*"bogus"}
	111
	112	test exec2-4.2 {env is invalid dict} -constraints jim -body {
	113	set saveenv $env
	114	lappend env bogus
	115	catch {exec pwd}
	116	} -result {0} -cleanup {
	117	set env $saveenv
	118	}
	119
	120	test exec2-4.3 {signalled process during foreground exec} -constraints {jim alarm} -body {
	121	# We need to exec a pipeline and then have one process
	122	# be killed by a signal
	123	exec [info nameofexecutable] -e {alarm 0.1; sleep 0.5}
	124	} -returnCodes error -result {child killed by signal SIGALRM}
	125
	126	test exec2-4.4 {exec - consecutive \|} -body {
	127	exec echo \| \| test
	128	} -returnCodes error -result {illegal use of \| or \|& in command}
	129
	130	test exec2-4.5 {exec - consecutive \| with &} -body {
	131	exec echo \| \| test &
	132	} -returnCodes error -result {illegal use of \| or \|& in command}
	133
	134	test exec2-4.6 {exec - illegal channel} -body {
	135	exec echo hello >@nonexistent
	136	} -returnCodes error -match glob -result {*"nonexistent"}
	137
	138	test exec2-5.1 {wait with invalid pid} wait {
	139	wait 9999999
	140	} {NONE -1 -1}
	141
	142	test exec2-5.2 {wait with invalid pid} -constraints wait -body {
	143	wait blah
	144	} -returnCodes error -result {expected integer but got "blah"}
	145
	146	test exec2-5.3 {wait - bad args} -constraints wait -body {
	147	wait too many args
	148	} -returnCodes error -result {wrong # args: should be "wait ?-nohang? ?pid?"}
	149
	150	test exec2-5.4 {wait -nohang} -constraints wait -body {
	151	set pid [exec sleep 0.2 &]
	152	# first wait will do nothing as the process is not finished
	153	wait -nohang $pid
	154	wait $pid
	155	} -match glob -result {CHILDSTATUS * 0}
	156
	157	test exec2-5.5 {wait for all children} -constraints {after jim} -body {
	158	# We want to have children finish at different times
	159	# so that we test the handling of the wait table
	160	foreach i {0.1 0.2 0.6 0.5 0.4 0.3} {
	161	exec sleep $i &
	162	}
	163	# reap zombies, there should not be any
	164	wait
	165	after 300
	166	# reap zombies, 2-3 should be finished now
	167	wait
	168	after 400
	169	# reap zombies, all processes should be finished now
	170	wait
	171	} -result {}
	172
102	173	testreport

+24

-16

tests/exists.test less more

0	0	source [file dirname [info script]]/testing.tcl
1	1
2	2	needs cmd exists
3		testConstraint lambda [expr {[info commands lambda] ne {}}]
	3	testCmdConstraints lambda
4	4
5	5	test exists-1.1 "Exists var" {
6	6	set a 1
7	7	exists a
8	8	} 1
9	9
10		test exists-1.1 "Exists var" {
	10	test exists-1.2 "Exists var" {
11	11	unset -nocomplain b
12	12	exists b
13	13	} 0
14	14
15		test exists-1.1 "Exists -var" {
	15	test exists-1.3 "Exists -var" {
16	16	exists -var a
17	17	} 1
18	18
19		test exists-1.1 "Exists -var" {
	19	test exists-1.4 "Exists -var" {
20	20	exists -var b
21	21	} 0
22	22
23		test exists-1.1 "Exists in proc" {
	23	test exists-1.5 "Exists in proc" {
24	24	proc a {name} { exists $name }
25	25	a ::a
26	26	} 1
27	27
28		test exists-1.1 "Exists in proc" {
	28	test exists-1.6 "Exists in proc" {
29	29	a ::b
30	30	} 0
31	31
32		test exists-1.1 "Exists in proc" {
	32	test exists-1.7 "Exists in proc" {
33	33	a name
34	34	} 1
35	35
36		test exists-1.1 "Exists in proc" {
	36	test exists-1.8 "Exists in proc" {
37	37	a none
38	38	} 0
39	39
40		test exists-1.1 "Exists -proc" {
	40	test exists-1.9 "Exists -proc" {
41	41	exists -proc a
42	42	} 1
43	43
44		test exists-1.1 "Exists -proc" {
	44	test exists-1.10 "Exists -proc" {
45	45	exists -proc bogus
46	46	} 0
47	47
48		test exists-1.1 "Exists -proc" {
	48	test exists-1.11 "Exists -proc" {
49	49	exists -proc info
50	50	} 0
51	51
52		test exists-1.1 "Exists -command" {
	52	test exists-1.12 "Exists -command" {
53	53	exists -command a
54	54	} 1
55	55
56		test exists-1.1 "Exists -command" {
	56	test exists-1.13 "Exists -command" {
57	57	exists -command info
58	58	} 1
59	59
60		test exists-1.1 "Exists -command" {
	60	test exists-1.14 "Exists -command" {
61	61	exists -command bogus
62	62	} 0
63	63
64		test exists-1.1 "Exists local lambda after exit" lambda {
	64	test exists-1.15 "Exists local lambda after exit" lambda {
65	65	proc a {} {
66	66	local lambda {} {dummy}
67	67	}
68	68	exists -proc [a]
69	69	} 0
70	70
71		test exists-1.1 "Exists local lambda" lambda {
	71	test exists-1.16 "Exists local lambda" lambda {
72	72	proc a {} {
73	73	exists -proc [local lambda {} {dummy}]
74	74	}
75	75	a
76	76	} 1
77	77
	78	test exists-1.17 {exists usage} -body {
	79	exists -dummy blah
	80	} -returnCodes error -result {bad option "-dummy": must be -alias, -command, -proc, or -var}
	81
	82	test exists-1.18 {exists usage} -body {
	83	exists abc def ghi
	84	} -returnCodes error -result {wrong # args: should be "exists ?option? name"}
	85
78	86	testreport

-1

tests/exitpackage.tcl less more

0	0	# This package just exits
1	1
2		exit 1
	2	exit

+237

-0

tests/expect.tcl less more

	0	# A simplified version of Tcl expect using a pseudo-tty pair
	1	# This could be turned into a standard module, but for now
	2	# it is just used in the test suite
	3
	4	# Example usage:
	5	#
	6	# set p [expect::spawn {cmd pipeline}]
	7	#
	8	# $p timeout 5
	9	# $p send "a command\r"
	10	# $p expect {
	11	# ab.*c {
	12	# script
	13	# }
	14	# d[a-z] {
	15	# script
	16	# }
	17	# EOF { ... }
	18	# TIMEOUT { ... }
	19	# }
	20	#
	21	# [$p before] returns data before the match
	22	# [$p after] returns data that matches the pattern
	23	# [$p buf] returns any data after the match that has been read
	24	# $p close
	25	#
	26	# $p tty ?...?
	27	# $p kill ?SIGNAL?
	28	if {![exists -command namespace]} {
	29	# Just enough to support [namespace current]
	30	proc namespace {args} {
	31	return ""
	32	}
	33	}
	34
	35	proc expect::spawn {cmd} {
	36	lassign [socket pty] m s
	37	# By default, turn off echo so that we can see just the output, not the input
	38	$m tty echo 0
	39	$m buffering none
	40	try {
	41	lappend cmd <@$s >@$s &
	42	set pids [exec {*}$cmd]
	43	$s close
	44	# Create a unique global variable for vwait
	45	set donevar ::[ref "" expect]
	46	set $donevar 0
	47	set matchinfo {
	48	buf {}
	49	}
	50
	51	return [namespace current]::[lambda {cmd args} {m pids {timeout 30} donevar matchinfo {debug 0}} {
	52	#puts "expect::spawn cmd=$cmd, matchinfo=$matchinfo"
	53	# Find our own name
	54	set self [lindex [info level 0] 0]
	55
	56	switch -exact -- $cmd {
	57	dputs {
	58	if {$debug} {
	59	set escapes {13 \\r 10 \\n 9 \\t 92 \\\\}
	60	lassign $args str
	61	# convert non-printable chars to printable
	62	set formatted {}
	63	binary scan $str cu* chars
	64	foreach c $chars {
	65	if {[exists escapes($c)]} {
	66	append formatted $escapes($c)
	67	} elseif {$c < 32} {
	68	append formatted [format \\x%02x $c]
	69	} elseif {$c > 127} {
	70	append formatted [format \\u%04x $c]
	71	} else {
	72	append formatted [format %c $c]
	73	}
	74	}
	75	puts $formatted
	76	}
	77	}
	78	kill {
	79	# kill the process with the given signal
	80	foreach i $pids {
	81	kill {*}$args $i
	82	}
	83	}
	84	pid {
	85	# return the process pids
	86	return $pids
	87	}
	88	getfd - tty {
	89	# pass through to the pty file descriptor
	90	tailcall $m $cmd {*}$args
	91	}
	92	close {
	93	# close the file descriptor, wait for the child process to complete
	94	# and return the result
	95	$m close
	96	set retopts {}
	97	foreach p $pids {
	98	lassign [wait $p] status - rc
	99	if {$status eq "CHILDSTATUS"} {
	100	# Don't treat a non-zero return code as fatal here
	101	if {[llength $retopts] <= 1} {
	102	set retopts $rc
	103	}
	104	continue
	105	} else {
	106	set msg "child killed: received signal"
	107	}
	108	set retopts [list -code error -errorcode [list $status $p $rc] $msg]
	109	}
	110	rename $self ""
	111
	112	return {*}$retopts
	113	}
	114	timeout - debug {
	115	# set or return the variable
	116	if {[llength $args]} {
	117	set $cmd [lindex $args 0]
	118	} else {
	119	return [set $cmd]
	120	}
	121	}
	122	send {
	123	$self dputs ">>> [lindex $args 0]"
	124	# send to the process
	125	$m puts -nonewline [lindex $args 0]
	126	$m flush
	127	}
	128	before - after - buf {
	129	# return the before, after and remaining data
	130	return $matchinfo($cmd)
	131	}
	132	handle {
	133	# Internal use only
	134	set args [lassign $args type]
	135	switch -- $type {
	136	timeout {
	137	$self dputs "\[TIMEOUT patterns=$matchinfo(patterns) buf=$matchinfo(buf)\]"
	138	# a timeout occurred
	139	set matchinfo(before) $matchinfo(buf)
	140	set matchinfo(buf) {}
	141	set matchinfo(matched_pattern) TIMEOUT
	142	incr $donevar
	143	return 1
	144	}
	145	eof {
	146	$self dputs "\[EOF\]"
	147	# EOF was reached
	148	set matchinfo(before) $matchinfo(buf)
	149	set matchinfo(buf) {}
	150	set matchinfo(matched_pattern) EOF
	151	incr $donevar
	152	return 1
	153	}
	154	data {
	155	# data was received
	156	lassign $args data
	157	$self dputs "<<< $data"
	158	append matchinfo(buf) $data
	159	foreach pattern $matchinfo(patterns) {
	160	set result [regexp -inline -indices $pattern $matchinfo(buf)]
	161	if {[llength $result]} {
	162	$self dputs "MATCH=\[$pattern\]"
	163	lassign [lindex $result 0] start end
	164	set matchinfo(before) [string range $matchinfo(buf) 0 $start-1]
	165	set matchinfo(after) [string range $matchinfo(buf) $start $end]
	166	set matchinfo(buf) [string range $matchinfo(buf) $end+1 end]
	167
	168	# Got a match, stop
	169	set matchinfo(matched_pattern) $pattern
	170	incr $donevar
	171	return 1
	172	}
	173	}
	174	}
	175	}
	176	return 0
	177	}
	178	expect {
	179	# Takes a list of regex-pattern, script, ... where the last script can be missing
	180	if {[llength $args] % 2 == 1} {
	181	lappend args {}
	182	}
	183
	184	# Stash all the state in the matchinfo dict
	185	# Keep matchinfo(buf)
	186	array set matchinfo {
	187	before {}
	188	after {}
	189	patterns {}
	190	matched_pattern {}
	191	}
	192
	193	foreach {pattern script} $args {
	194	lappend matchinfo(patterns) $pattern
	195	}
	196
	197	# Handle the case where there is buffered data
	198	# that matches the pattern
	199	if {[$self handle data {}] == 0} {
	200	$m readable [namespace current]::[lambda {} {m self} {
	201	$m ndelay 1
	202	try {
	203	set buf [$m read]
	204	if {$buf eq ""} {
	205	$self handle eof "EOF"
	206	} else {
	207	$self handle data $buf
	208	}
	209	} on error msg {
	210	$self handle eof $msg
	211	}
	212	$m ndelay 0
	213	}]
	214	set matchinfo(afterid) [after $($timeout * 1e3) [list $self handle timeout]]
	215
	216	vwait $donevar
	217
	218	after cancel $matchinfo(afterid)
	219	}
	220
	221	# Now invoke the matching script
	222	if {[dict exists $args $matchinfo(matched_pattern)]} {
	223	uplevel 1 [dict get $args $matchinfo(matched_pattern)]
	224	}
	225	# And return the data that matched the pattern
	226	# (is $matchinfo(before) more generally useful?)
	227	return $matchinfo(after)
	228	}
	229	}
	230	}]
	231	} on error {error opts} {
	232	catch {$m close}
	233	catch {$s close}
	234	return -code error $error
	235	}
	236	}

-0

tests/expr-base.test less more

14	14	-0b111 -7
15	15	-0B101 -5
16	16	0o7 7
	17	0d0 0
	18	0d7 7
	19	0d99 99
	20	0d099 99
	21	-0d099 -99
17	22	}
18	23
19	24	set i 0

33	38	0x-5
34	39	{0x 5}
35	40	{0o8 + 1}
	41	0d-5
	42	0dff
36	43	}
37	44
38	45	set i 0

+108

-3

tests/expr-new.test less more

69	69	expr -25
70	70	} -25
71	71	test expr-1.3 {TclCompileExprCmd: two expression words} {
72		expr -8.2 -6
	72	expr {-8.2 -6}
73	73	} -14.2
74	74	test expr-1.4 {TclCompileExprCmd: five expression words} {
75		expr 20 - 5 +10 -7
	75	expr {20 - 5 +10 -7}
76	76	} 18
77	77	test expr-1.5 {TclCompileExprCmd: quoted expression word} {
78	78	expr "0005"

110	110	} foo
111	111	test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
112	112	set a xxx
113		set x 2; set b {$x}; set a [expr $b == 2]
	113	set x 2; set b {$x}; set a [expr "$b == 2"]
114	114	set a
115	115	} 1
116	116

259	259	test expr-8.11 {CompileEqualityExpr: error compiling equality arm} {
260	260	catch {expr 2!=x} msg
261	261	} {1}
	262
	263
	264	test expr-8.36 {CompileEqualtyExpr: string comparison ops} {
	265	set x 012
	266	set y 0x0
	267	list [expr {$x < $y}] [expr {$x lt $y}] [expr {$x lt $x}]
	268	} {0 1 0}
	269	test expr-8.37 {CompileEqualtyExpr: string comparison ops} {
	270	set x 012
	271	set y 0x0
	272	list [expr {$x <= $y}] [expr {$x le $y}] [expr {$x le $x}]
	273	} {0 1 1}
	274	test expr-8.38 {CompileEqualtyExpr: string comparison ops} {
	275	set x 012
	276	set y 0x0
	277	list [expr {$x > $y}] [expr {$x gt $y}] [expr {$x gt $x}]
	278	} {1 0 0}
	279	test expr-8.39 {CompileEqualtyExpr: string comparison ops} {
	280	set x 012
	281	set y 0x0
	282	list [expr {$x >= $y}] [expr {$x ge $y}] [expr {$x ge $x}]
	283	} {1 0 1}
262	284
263	285
264	286	test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12

626	648	}
627	649	} 1
628	650
	651	# This test won't fail if shimmering isn't handled
	652	# correctly, but it will leak memory. configure with --maintainer
	653	# to see the issue.
	654	test expr-21.1 {expr shimmering} {
	655	set x {[a] + 2}
	656	proc a {} {
	657	upvar x x
	658	# make the expression become a list while we are executing it
	659	lindex $x 2
	660	}
	661	expr $x
	662	} {4}
	663
	664	test expr-22.1 {expr} -body {
	665	expr {1 + $nonexistent}
	666	} -returnCodes error -result {can't read "nonexistent": no such variable}
	667
	668	test expr-22.2 {expr} -body {
	669	expr {~$nonexistent}
	670	} -returnCodes error -result {can't read "nonexistent": no such variable}
	671
	672	test expr-22.3 {expr} -body {
	673	expr {abs($nonexistent)}
	674	} -returnCodes error -result {can't read "nonexistent": no such variable}
	675
	676	test expr-22.4 {expr} -body {
	677	expr {[nonexistent] << 4}
	678	} -returnCodes error -result {invalid command name "nonexistent"}
	679
	680	test expr-22.5 {expr} -body {
	681	expr {5 >> [nonexistent]}
	682	} -returnCodes error -result {invalid command name "nonexistent"}
	683
	684	test expr-22.6 {expr} -body {
	685	expr {$nonexistent in {a b c}}
	686	} -returnCodes error -result {can't read "nonexistent": no such variable}
	687
	688	test expr-22.7 {expr} -body {
	689	expr {"a" ni $nonexistent}
	690	} -returnCodes error -result {can't read "nonexistent": no such variable}
	691
	692	test expr-22.8 {expr} -body {
	693	expr {5 + $}
	694	} -returnCodes error -result {syntax error in expression: "5 + $"}
	695
	696	test expr-22.9 {expr} -body {
	697	expr {. + 1}
	698	} -returnCodes error -result {syntax error in expression: ". + 1"}
	699
	700	test expr-22.10 {expr} -body {
	701	expr {5 + ,}
	702	} -returnCodes error -result {unexpected comma in expression: "5 + ,"}
	703
	704	test expr-22.11 {expr} -body {
	705	expr {round(1,2,3,4)}
	706	} -returnCodes error -result {too many arguments to math function}
	707
	708	test expr-22.12 {expr} {
	709	expr {inf}
	710	} {Inf}
	711
	712	test expr-23.1 {expr TIP 582 comments} {
	713	expr {1 + # comment on line 1
	714	2}
	715	} {3}
	716
	717	test expr-23.2 {expr TIP 582 comments} {
	718	expr {1 +
	719	# comment on line 2
	720	2
	721	}
	722	} {3}
	723
	724	test expr-23.3 {expr TIP 582 comments} {
	725	expr {1 +
	726	# Multiple lines
	727	# of comments
	728	2
	729	}
	730	} {3}
	731
	732
	733
629	734	# cleanup
630	735	if {[info exists a]} {
631	736	unset a

+17

-15

tests/expr-old.test less more

127	127	test expr-old-2.36 {floating-point operators} {expr 3.3>2.3?44.3:66.3} 44.3
128	128	test expr-old-2.37 {floating-point operators} {expr 2.3>3.3?44.3:66.3} 66.3
129	129	test expr-old-2.38 {floating-point operators} {
130		list [catch {expr 028.1 + 09.2} msg] $msg
	130	list [catch {expr {028.1 + 09.2}} msg] $msg
131	131	} {0 37.3}
132	132
133	133	# Operators that aren't legal on floating-point numbers

442	442	test expr-old-26.10 {error conditions} {
443	443	expr 2.0/0.0
444	444	} {Inf}
445		test expr-old-26.11 {error conditions} {
446		list [catch {expr 2#} msg]
447		} {1}
	445	# Note that this is no longer an error with TIP 582
	446	#
	447	#test expr-old-26.11 {error conditions} {
	448	# list [catch {expr 2#} msg]
	449	#} {1}
448	450	test expr-old-26.12 {error conditions} {
449	451	list [catch {expr a.b} msg]
450	452	} {1}

550	552	# Expressions spanning multiple arguments
551	553
552	554	test expr-old-31.1 {multiple arguments to expr command} {
553		expr 4 + ( 6 *12) -3
	555	expr {4 + ( 6 *12) -3}
554	556	} 73
555	557	test expr-old-31.2 {multiple arguments to expr command} {
556	558	list [catch {expr 2 + (3 + 4} msg]

574	576	format %.6g [expr atan(1.0)]
575	577	} {0.785398}
576	578	test expr-old-32.4 {math functions in expressions} mathfunc {
577		format %.6g [expr atan2(2.0, 2.0)]
	579	format %.6g [expr {atan2(2.0, 2.0)}]
578	580	} {0.785398}
579	581	test expr-old-32.5 {math functions in expressions} mathfunc {
580	582	format %.6g [expr ceil(1.999)]

595	597	format %.6g [expr floor(2.001)]
596	598	} {2}
597	599	test expr-old-32.11 {math functions in expressions} expr_fmod {
598		format %.6g [expr fmod(7.3, 3.2)]
	600	format %.6g [expr {fmod(7.3, 3.2)}]
599	601	} {0.9}
600	602	test expr-old-32.12 {math functions in expressions} expr_hypot {
601		format %.6g [expr hypot(3.0, 4.0)]
	603	format %.6g [expr {hypot(3.0, 4.0)}]
602	604	} {5}
603	605	test expr-old-32.13 {math functions in expressions} mathfunc {
604	606	format %.6g [expr log(2.8)]

607	609	format %.6g [expr log10(2.8)]
608	610	} {0.447158}
609	611	test expr-old-32.15 {math functions in expressions} mathfunc {
610		format %.6g [expr pow(2.1, 3.1)]
	612	format %.6g [expr {pow(2.1, 3.1)}]
611	613	} {9.97424}
612	614	test expr-old-32.16 {math functions in expressions} mathfunc {
613	615	format %.6g [expr sin(.1)]

689	691	# list [catch {expr round(-1e60)} msg] $msg
690	692	#} {1 {integer value too large to represent}}
691	693	test expr-old-32.41 {math functions in expressions} mathfunc {
692		list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
	694	list [catch {expr {pow(1.0 + 3.0 - 2, .8 * 5)}} msg] $msg
693	695	} {0 16.0}
694	696	if {1} {
695	697	test expr-old-32.42 {math functions in expressions} expr_hypot {

699	701	expr {pow(1.0 + 3.0, -2)}
700	702	} {0.0625}
701	703	test expr-old-32.45 {math functions in expressions} {
702		expr (0 <= rand()) && (rand() < 1)
	704	expr {(0 <= rand()) && (rand() < 1)}
703	705	} {1}
704	706	test expr-old-32.46 {math functions in expressions} -body {
705	707	expr rand(24)

716	718	} -returnCodes error -match glob -result *
717	719	test expr-old-32.50 {math functions in expressions} mathfunc {
718	720	for {set i 0} {$i < 10} {incr i} {
719		lappend result [expr round(sin($i) * 1000)]
	721	lappend result [expr {round(sin($i) * 1000)}]
720	722	}
721	723	set result
722	724	} {0 841 909 141 -757 -959 -279 657 989 412}

725	727	} -returnCodes error -match glob -result *
726	728
727	729	test expr-old-33.1 {conversions and fancy args to math functions} expr_hypot {
728		expr hypot ( 3 , 4 )
	730	expr {hypot ( 3 , 4 )}
729	731	} 5.0
730	732	test expr-old-33.2 {conversions and fancy args to math functions} expr_hypot {
731		expr hypot ( (2.0+1.0) , 4 )
	733	expr {hypot ( (2.0+1.0) , 4 )}
732	734	} 5.0
733	735	test expr-old-33.3 {conversions and fancy args to math functions} expr_hypot {
734		expr hypot ( 3 , (3.0 + 1.0) )
	736	expr {hypot ( 3 , (3.0 + 1.0) )}
735	737	} 5.0
736	738	test expr-old-33.4 {conversions and fancy args to math functions} mathfunc {
737	739	format %.6g [expr cos(acos(0.1))]

+14

-1

tests/expr.test less more

10	10	} {1}
11	11
12	12	test expr-1.3 "Hex values" {
13		set mask1 [expr 0x4050 & 0x0CCC]
	13	set mask1 [expr {0x4050 & 0x0CCC}]
14	14	} {64}
15	15
16	16	test expr-1.4 "Ternary operator - true" {

141	141	set a
142	142	} {2}
143	143
	144	test expr-5.1 "Not" {
	145	lmap x {1 0 true false on off yes no} { expr {!$x} }
	146	} {0 1 0 1 0 1 0 1}
	147
	148	test expr-5.2 "Not" -body {
	149	expr {!this}
	150	} -returnCodes error -result {syntax error in expression: "!this"}
	151
	152	test expr-5.3 {boolean in expression} {
	153	expr {true ? 4 : 5}
	154	} {4}
	155
	156
144	157	testreport

+278

-0

tests/file.test less more

0	0	source [file dirname [info script]]/testing.tcl
1	1
2	2	needs cmd file
	3	catch {file link} msg
	4	testConstraint filelink [string match "wrong # args:*" $msg]
	5	catch {file lstat} msg
	6	testConstraint filelstat [string match "wrong # args:*" $msg]
	7	testConstraint unix [expr {$tcl_platform(platform) eq "unix"}]
	8	if {[testConstraint jim]} {
	9	testConstraint mtimeset [expr {!$tcl_platform(bootstrap)}]
	10	} else {
	11	testConstraint mtimeset 1
	12	}
3	13
4	14	test join-1.1 "One name" {
5	15	file join abc

115	125	test dirname-1.4 "Trailing slash" {
116	126	file dirname abc/
117	127	} {.}
	128
	129	test dirname-1.5 ".." {
	130	file dirname ..
	131	} {.}
	132
	133	test dirname-1.6 "abc/.." {
	134	file dirname abc/..
	135	} {abc}
	136
	137	test dirname-1.7 "../abc" {
	138	file dirname ../abc
	139	} {..}
	140
	141	test stat-1.1 {file stat usage} -body {
	142	file stat
	143	} -returnCodes error -match glob -result {wrong # args: should be "file stat name*"}
	144
	145	test stat-1.2 {file stat usage} -body {
	146	file stat nonexistent a
	147	} -returnCodes error -match glob -result {could not read "nonexistent": *}
	148
	149	test stat-1.3 {file stat} {
	150	unset -nocomplain a
	151	file stat [info script] a
	152	set a(type)
	153	} {file}
	154
	155	test stat-1.4 {file stat update array} {
	156	set a(type) bogus
	157	file stat [info nameofexecutable] a
	158	set a(type)
	159	} {file}
	160
	161	test stat-1.5 {file stat update bad array} -body {
	162	unset -nocomplain a
	163	# invalid dict/array
	164	set a {1 2 3}
	165	file stat [info nameofexecutable] a
	166	} -returnCodes error -result {can't set "a(dev)": variable isn't array}
	167
	168	test stat-1.7 {file stat no variable} jim {
	169	set a [file stat [info script]]
	170	set a(type)
	171	} {file}
	172
	173	test ext-1.1 {file ext} -body {
	174	file ext
	175	} -returnCodes error -result {wrong # args: should be "file extension name"}
	176
	177	test ext-1.2 {file ext basic} {
	178	file ext abc.def
	179	} {.def}
	180
	181	test ext-1.3 {file ext path} {
	182	file ext 123/abc.def
	183	} {.def}
	184
	185	test ext-1.4 {file ext noext} {
	186	file ext abc
	187	} {}
	188
	189	test ext-1.5 {file ext noext} {
	190	file ext abc.def/ghi
	191	} {}
	192
	193	test rootname-1.1 {file rootname} -body {
	194	file rootname
	195	} -returnCodes error -result {wrong # args: should be "file rootname name"}
	196
	197	test rootname-1.2 {file rootname basic} -body {
	198	file rootname abc
	199	} -result {abc}
	200
	201	test rootname-1.3 {file rootname basic} -body {
	202	file rootname abc/def
	203	} -result {abc/def}
	204
	205	test rootname-1.4 {file rootname basic} -body {
	206	file rootname abc.c
	207	} -result {abc}
	208
	209	test rootname-1.5 {file rootname basic} -body {
	210	file rootname abc/def.c
	211	} -result {abc/def}
	212
	213	test rootname-1.6 {file rootname odd cases} -body {
	214	file rootname abc/def.c/ghi
	215	} -result {abc/def.c/ghi}
	216
	217	test rootname-1.7 {file rootname odd cases} -body {
	218	file rootname abc/def.c/
	219	} -result {abc/def.c/}
	220
	221	test rootname-1.8 {file rootname odd cases} -body {
	222	file rootname abc/def.c//
	223	} -result {abc/def.c//}
	224
	225	test readable-1.1 {file readable} {
	226	file readable [info script]
	227	} {1}
	228
	229	test writable-1.1 {file writable} -body {
	230	set name tmp.[pid]
	231	makeFile testing $name
	232	file writable $name
	233	} -result 1 -cleanup {
	234	file delete $name
	235	}
	236
	237	test rename-1.1 {file rename usage} -body {
	238	file rename
	239	} -returnCodes error -match glob -result {wrong # args: should be *}
	240
	241	test rename-1.2 {file rename usage} -body {
	242	file rename -badarg name1 name2
	243	} -returnCodes error -match glob -result {*}
	244
	245	test rename-1.1 {file rename, target exists} -body {
	246	set name1 tmp.[pid]
	247	set name2 tmp2.[pid]
	248	makeFile testing $name1
	249	makeFile testing2 $name2
	250	file rename $name1 $name2
	251	} -returnCodes error -match glob -result {error renaming *}
	252
	253	test rename-1.2 {file rename -force, target exists} -body {
	254	file rename -force $name1 $name2
	255	list [file exists $name1] [file exists $name2]
	256	} -result {0 1} -cleanup {
	257	file delete $name2
	258	}
	259
	260	test link-1.1 {file link usage} -constraints filelink -body {
	261	file link
	262	} -returnCodes error -match glob -result {wrong # args: should be "file link*}
	263
	264	test link-1.2 {file hard link} -constraints filelink -body {
	265	set name tmp.[pid]
	266	file link $name [info script]
	267	file exists $name
	268	} -result {1} -cleanup {
	269	file delete $name
	270	}
	271
	272	test link-1.3 {file hard link} -constraints filelink -body {
	273	set name tmp.[pid]
	274	file link -hard $name [info script]
	275	file exists $name
	276	} -result {1} -cleanup {
	277	file delete $name
	278	}
	279
	280	test link-1.4 {file sym link} -constraints filelink -body {
	281	set name tmp.[pid]
	282	file link -sym $name [info script]
	283	list [file exists $name] [file tail [file readlink $name]]
	284	} -result {1 file.test} -cleanup {
	285	file delete $name
	286	}
	287
	288	test link-1.5 {file readlink, bad link} -constraints filelink -body {
	289	file readlink [info script]
	290	} -returnCodes error -match glob -result {could not readlink "file.test": *}
	291
	292	test link-1.6 {file link badopt} -constraints filelink -body {
	293	file link -bad name1 name2
	294	} -returnCodes error -match glob -result {bad * "-bad": must be *}
	295
	296	test lstat-1.1 {file lstat} -constraints filelstat -body {
	297	file lstat
	298	} -returnCodes error -match glob -result {wrong # args: should be "file lstat name *}
	299
	300	test lstat-1.2 {file lstat} -constraints filelstat -body {
	301	file lstat nonexistent ls
	302	} -returnCodes error -match glob -result {could not read "nonexistent": *}
	303
	304	test lstat-1.3 {file lstat} -constraints {filelink filelstat} -body {
	305	set name tmp.[pid]
	306	file link -sym $name [info script]
	307	unset -nocomplain s ls
	308	file lstat $name ls
	309	file stat [info script] s
	310	list $ls(type) $s(type)
	311	} -match glob -result {link file} -cleanup {
	312	file delete $name
	313	}
	314
	315	test type-1.1 {file type} {
	316	file type [info script]
	317	} {file}
	318
	319	test type-1.2 {file type} {
	320	file type [file dirname [info script]]
	321	} {directory}
	322
	323	test type-1.2 {file type} -body {
	324	file type nonexistent
	325	} -returnCodes error -match glob -result {could not read "nonexistent": *}
	326
	327	test isfile-1.1 {file isfile} -body {
	328	file isfile
	329	} -returnCodes error -result {wrong # args: should be "file isfile name"}
	330
	331	test isfile-1.2 {file isfile} {
	332	file isfile [info script]
	333	} {1}
	334
	335	test isfile-1.3 {file isfile} {
	336	file isfile [file dirname [info script]]
	337	} {0}
	338
	339	test size-1.1 {file size} -body {
	340	file size
	341	} -returnCodes error -result {wrong # args: should be "file size name"}
	342
	343	test size-1.2 {file size} -body {
	344	file size nonexistent
	345	} -returnCodes error -match glob -result {could not read "nonexistent":*}
	346
	347	test size-1.3 {file size} {
	348	set size [file size [info script]]
	349	file stat [info script] s
	350	expr {$size - $s(size)}
	351	} {0}
	352
	353	test mtime-1.1 {file mtime} -body {
	354	file mtime
	355	} -returnCodes error -result {wrong # args: should be "file mtime name ?time?"}
	356
	357	test mtime-1.2 {file mtime} -body {
	358	file mtime nonexistent
	359	} -returnCodes error -match glob -result {could not read "nonexistent":*}
	360
	361	test mtime-1.3 {file mtime} -body {
	362	file mtime [info script] bad
	363	} -returnCodes error -result {expected integer but got "bad"}
	364
	365	test mtime-1.4 {file mtime} {
	366	set mtime [file mtime [info script]]
	367	file stat [info script] s
	368	if {$mtime != $s(mtime)} {
	369	error "mtime was $mtime but s(mtime) was $s(mtime)"
	370	}
	371	} {}
	372
	373	test mtime-1.5 {file mtime} -constraints {mtimeset unix} -body {
	374	set name tmp.[pid]
	375	makeFile testing $name
	376	set t [file mtime [info script]]
	377	file mtime $name $t
	378	expr {$t - [file mtime $name]}
	379	} -result {0} -cleanup {
	380	file delete $name
	381	}
	382
	383	test atime-1.1 {file atime} -body {
	384	file atime
	385	} -returnCodes error -match glob -result {wrong # args: should be "file atime name*}
	386
	387	test atime-1.2 {file atime} -body {
	388	file atime nonexistent
	389	} -returnCodes error -match glob -result {could not read "nonexistent":*}
	390
	391	test atime-1.3 {file atime} {
	392	set atime [file atime [info script]]
	393	file stat [info script] s
	394	expr {$atime - $s(atime)}
	395	} {0}
118	396
119	397	# These tests are courtesy of picol
120	398

+27

-0

tests/filecopy.test less more

3	3	needs cmd file
4	4	needs cmd exec
5	5	needs cmd parray tclcompat
	6
	7	testConstraint unix [expr {$tcl_platform(platform) eq "unix"}]
6	8
7	9	cd [file dirname [info script]]
8	10

67	69	file size tempfile
68	70	} 16
69	71
	72	test file-tempfile-1.1 {file tempfile - simple} {
	73	set f [file tempfile]
	74	set ret [file exists $f]
	75	file delete $f
	76	set ret
	77	} {1}
	78
	79	# Note that Windows doesn't provide much control over the tempfile.
	80	# Only the first 3 chars of the pattern are used, so ignore these tests on that platform
	81
	82	test file-tempfile-1.2 {file tempfile with pattern} unix {
	83	set f [file tempfile /tmp/file-tempfile.XXXXXX]
	84	set ret [file exists $f]
	85	file delete $f
	86	set ret
	87	} {1}
	88
	89	test file-tempfile-1.3 {file tempfile with invalid path} -constraints unix -body {
	90	set f [file tempfile /doesnotexist/file-tempfile.XXXXXX]
	91	puts $f
	92	set ret [file exists $f]
	93	file delete $f
	94	set $f
	95	} -returnCodes error -match glob -result {/doesnotexist/file-tempfile.*}
	96
70	97	file delete tempfile
71	98	file delete --force tempdir
72	99

-6

tests/format.test less more

418	418	set a 0.0000000000001
419	419	set b 0.00000000000001
420	420	set c 0.00000000000000001
421		set d [expr $a + $b + $c]
	421	set d [expr {$a + $b + $c}]
422	422	format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
423	423	} {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001}
424	424	test format-13.2 {tcl_precision fuzzy comparison} {

429	429	set a 0.000000000001
430	430	set b 0.000000000000005
431	431	set c 0.0000000000000008
432		set d [expr $a + $b + $c]
	432	set d [expr {$a + $b + $c}]
433	433	format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
434	434	} {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580}
435	435	test format-13.3 {tcl_precision fuzzy comparison} {

438	438	catch {unset c}
439	439	set a 0.00000000000099
440	440	set b 0.000000000000011
441		set c [expr $a + $b]
	441	set c [expr {$a + $b}]
442	442	format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c
443	443	} {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100}
444	444	test format-13.4 {tcl_precision fuzzy comparison} {

447	447	catch {unset c}
448	448	set a 0.444444444444
449	449	set b 0.33333333333333
450		set c [expr $a + $b]
	450	set c [expr {$a + $b}]
451	451	format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c
452	452	} {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300}
453	453	test format-13.5 {tcl_precision fuzzy comparison} {

456	456	catch {unset c}
457	457	set a 0.444444444444
458	458	set b 0.99999999999999
459		set c [expr $a + $b]
	459	set c [expr {$a + $b}]
460	460	format {%0.10f %0.12f %0.15f} $c $c $c
461	461	} {1.4444444444 1.444444444444 1.444444444443990}
462	462	test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} {

485	485	append b $a
486	486	}
487	487	for {set i 290} {$i < 400} {incr i} {
488		test format-15.[expr $i -290] {testing MAX_FLOAT_SIZE} {
	488	test format-15.[expr {$i -290}] {testing MAX_FLOAT_SIZE} {
489	489	format {%s} $b
490	490	} $b
491	491	append b "x"

+45

-0

tests/history.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs cmd history
	3
	4	test history-1.1 {history usage} -body {
	5	history
	6	} -returnCodes error -result {wrong # args: should be "history command ..."
	7	Use "history -help ?command?" for help}
	8
	9	test history-1.2 {history -help} -body {
	10	history -help
	11	} -result {Usage: "history command ... ", where command is one of: add, completion, getline, keep, load, save, show}
	12
	13	test history-1.2 {history add} {
	14	history add line1
	15	history add "line2 next"
	16	set name tmp.[pid]
	17	history save $name
	18	set f [open $name]
	19	set lines [split [string trimright [read $f]] \n]
	20	} {line1 {line2 next}}
	21
	22	test history-1.3 {history load} {
	23	history load $name
	24	} {}
	25
	26	test history-1.4 {history completion usage} -body {
	27	history completion
	28	} -returnCodes error -result {wrong # args: should be "history completion command"}
	29
	30	test history-1.5 {history completion} {
	31	history completion command
	32	} {}
	33
	34	test history-1.6 {history completion} {
	35	history completion {}
	36	} {}
	37
	38	catch {
	39	file delete $name
	40	}
	41
	42	# Can't really test history add, show, setcompletion
	43
	44	testreport

-2

tests/infoframe.test less more

1	1	needs constraint jim
2	2	proc a {n} {
3	3	if {$n eq "trace"} {
4		stacktrace
	4	basename-stacktrace [stacktrace]
5	5	} else {
6		info frame $n
	6	basename-stacktrace [info frame $n]
7	7	}
8	8	}
9	9

+138

-0

tests/interactive.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3	needs cmd socket
	4
	5	package require expect
	6
	7	set saveenv $env
	8
	9	# Make sure we start with an empty history
	10	set env(HOME) [pwd]
	11	file delete .jim_history
	12
	13	# spawn the process to be used for testing
	14	set p [expect::spawn [list [info nameofexecutable]]]
	15
	16	set env $saveenv
	17
	18	$p timeout 1
	19	# Turn on echo since we get echo with linenoise anyway
	20	$p tty echo 1
	21
	22	proc wait-for-prompt {p} {
	23	$p expect {\. }
	24	}
	25
	26	# Start with an empty history
	27	file delete test_history
	28	wait-for-prompt $p
	29	$p send "history load test_history\r"
	30	# skip echoed output
	31	$p expect {\r\n}
	32	wait-for-prompt $p
	33
	34	test interactive-1.1 {basic command} -body {
	35	$p send "lsort \[info commands li*\]\r"
	36	# skip echoed output
	37	$p expect {\r\n}
	38	# get command result
	39	$p expect {\r\n}
	40	$p before
	41	} -result {lindex linsert list} -cleanup {
	42	wait-for-prompt $p
	43	}
	44
	45	test interactive-1.2 {command line completion} {
	46	set check 0
	47	set failed 0
	48	$p send "li\t"
	49	$p expect {lindex} { incr check } TIMEOUT { incr failed }
	50	if {!$failed} {
	51	$p send "\t"
	52	$p expect {linsert} { incr check }
	53	$p send "\t"
	54	$p expect {list} { incr check }
	55	$p send \r
	56	}
	57	$p expect {\r\n}
	58	wait-for-prompt $p
	59
	60	list $check $failed
	61	} {3 0}
	62
	63	test interactive-1.3 {history show} -body {
	64	$p send "history show\r"
	65	$p expect {\r\n}
	66	$p expect {history show\r\n}
	67	string cat [$p before] [$p after]
	68	} -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 {
	69	wait-for-prompt $p
	70	}
	71
	72	test interactive-1.4 {history getline} -body {
	73	$p send "history getline {PROMPT> }\r"
	74	$p expect {\r\n}
	75	sleep 0.25
	76	$p send "abc\bd\x01e\r"
	77	$p expect {\r\n}
	78	$p expect {\r\n}
	79	$p before
	80	} -result {eabd} -cleanup {
	81	wait-for-prompt $p
	82	}
	83
	84	test interactive-1.4 {history getline} -body {
	85	$p send "set len \[history getline {PROMPT> } buf\]\r"
	86	$p expect {\r\n}
	87	sleep 0.25
	88	$p send "abcde\r"
	89	$p expect {\r\n}
	90	$p expect {\r\n}
	91	sleep 0.25
	92	$p wait-for-prompt
	93	$p send "list \$len \$buf\r"
	94	$p expect {\r\n}
	95	$p expect {\r\n}
	96	$p before
	97	} -result {5 abcde} -cleanup {
	98	wait-for-prompt $p
	99	}
	100
	101	test interactive-1.5 {insert wide character} -constraints utf8 -body {
	102	$p send "set x a\u1100b"
	103	# now arrow left twice over the wide char and insert another char
	104	$p send \x1bOD
	105	$p send \x1bOD
	106	$p send y
	107	$p send \r
	108	$p expect {\r\n}
	109	sleep 0.25
	110	$p expect {\r\n}
	111	$p before
	112	} -result ay\u1100b -cleanup {
	113	wait-for-prompt $p
	114	}
	115
	116	test interactive-1.6 {insert utf-8 combining character} -constraints utf8 -body {
	117	$p send "set x x\u0300"
	118	# now arrow left twice over the combining char and "x" and insert another char
	119	$p send \x1bOD
	120	$p send \x1bOD
	121	$p send y
	122	$p send \r
	123	$p expect {\r\n}
	124	sleep 0.25
	125	$p expect {\r\n}
	126	$p before
	127	} -result yx\u0300 -cleanup {
	128	wait-for-prompt $p
	129	}
	130
	131	# send ^D to cause the interpeter to exit
	132	$p send \x04
	133	sleep 0.25
	134	$p expect EOF
	135	$p close
	136
	137	testreport

+133

-0

tests/intexpr.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3
	4	# There are two kinds of commands that use (safe) integer expressions:
	5	# direct: loop, range, incr, string repeat, lrepeat, pack, unpack, rand
	6	# index: lindex, linsert, lreplace, lset, lrange, lsort, regexp, regsub, string index,first,last,range
	7	#
	8	# Since they are all identical under the covers, we only test one from each group here,
	9	# string repeat and string index
	10
	11	test intexpr-1.1 {string repeat} {
	12	string repeat a 2+1
	13	} {aaa}
	14
	15	test intexpr-1.2 {string repeat} {
	16	string repeat a 2-1
	17	} {a}
	18
	19	test intexpr-1.3 {string repeat} {
	20	string repeat a 2*3
	21	} {aaaaaa}
	22
	23	test intexpr-1.4 {string repeat - function calls} {
	24	string repeat a int(abs(-2))
	25	} {aa}
	26
	27	test intexpr-1.4 {string repeat - expanded var} {
	28	set n 3
	29	string repeat a $n+1
	30	} {aaaa}
	31
	32	test intexpr-1.5 {string repeat - no subst var} -body {
	33	set n 3
	34	string repeat a {$n+1}
	35	} -returnCodes error -result {expected integer expression but got "$n+1"}
	36
	37	test intexpr-1.6 {string repeat - no subst cmd} -body {
	38	string repeat a {[string length xy]+1}
	39	} -returnCodes error -result {expected integer expression but got "[string length xy]+1"}
	40
	41	test intexpr-1.6 {string repeat - no subst dictvar} -body {
	42	set b(3) 4
	43	string repeat a {$b(4)}
	44	} -returnCodes error -result {expected integer expression but got "$b(4)"}
	45
	46	test intexpr-1.7 {string repeat - no subst dictvar} -body {
	47	set b(3) 4
	48	string repeat a {$b(4)+2}
	49	} -returnCodes error -result {expected integer expression but got "$b(4)+2"}
	50
	51	set str abcdefghi
	52	test intexpr-2.1 {string index} {
	53	string index $str 2+1
	54	} {d}
	55
	56	test intexpr-2.2 {string index} {
	57	string index $str 2-1
	58	} {b}
	59
	60	test intexpr-2.3 {string index} {
	61	string index $str 2*3
	62	} {g}
	63
	64	test intexpr-2.4 {string index - function calls} {
	65	string index $str int(abs(-2))
	66	} {c}
	67
	68	test intexpr-2.4 {string index - expanded var} {
	69	set n 3
	70	string index $str $n+1
	71	} {e}
	72
	73	test intexpr-2.5 {string index - no subst var} -body {
	74	set n 3
	75	string index $str {$n+1}
	76	} -returnCodes error -result {bad index "$n+1": must be intexpr or end?[+-]intexpr?}
	77
	78	test intexpr-2.6 {string index - no subst cmd} -body {
	79	string index $str {[string length xy]+1}
	80	} -returnCodes error -result {bad index "[string length xy]+1": must be intexpr or end?[+-]intexpr?}
	81
	82	test intexpr-2.6 {string index - no subst dictvar} -body {
	83	set b(3) 4
	84	string index $str {$b(4)}
	85	} -returnCodes error -result {bad index "$b(4)": must be intexpr or end?[+-]intexpr?}
	86
	87	test intexpr-2.7 {string index - no subst dictvar} -body {
	88	set b(3) 4
	89	string index $str {$b(4)+2}
	90	} -returnCodes error -result {bad index "$b(4)+2": must be intexpr or end?[+-]intexpr?}
	91
	92	test intexpr-3.1 {string index} {
	93	string index $str end-2+1
	94	} {h}
	95
	96	test intexpr-3.2 {string index} {
	97	string index $str end-2-1
	98	} {f}
	99
	100	test intexpr-3.3 {string index} {
	101	string index $str end-2*3
	102	} {c}
	103
	104	test intexpr-3.4 {string index - function calls} {
	105	string index $str end+int(-2)
	106	} {g}
	107
	108	test intexpr-3.4 {string index - expanded var} {
	109	set n 3
	110	string index $str end-($n+1)
	111	} {e}
	112
	113	test intexpr-3.5 {string index - no subst var} -body {
	114	set n 3
	115	string index $str {end-($n+1)}
	116	} -returnCodes error -result {bad index "end-($n+1)": must be intexpr or end?[+-]intexpr?}
	117
	118	test intexpr-3.6 {string index - no subst cmd} -body {
	119	string index $str {end-[string length xy]+1}
	120	} -returnCodes error -result {bad index "end-[string length xy]+1": must be intexpr or end?[+-]intexpr?}
	121
	122	test intexpr-3.6 {string index - no subst dictvar} -body {
	123	set b(3) 4
	124	string index $str {end-$b(4)}
	125	} -returnCodes error -result {bad index "end-$b(4)": must be intexpr or end?[+-]intexpr?}
	126
	127	test intexpr-3.7 {string index - no subst dictvar} -body {
	128	set b(3) -4
	129	string index $str {end+$b(4)-2}
	130	} -returnCodes error -result {bad index "end+$b(4)-2": must be intexpr or end?[+-]intexpr?}
	131
	132	testreport

+135

-34

tests/jim.test less more

10	10
11	11	needs constraint jim
12	12	catch {package require regexp}
13		testConstraint regexp [expr {[info commands regexp] ne {}}]
14		testConstraint lambda [expr {[info commands ref] ne {}}]
	13	testCmdConstraints regexp readdir lambda
15	14
16	15	################################################################################
17	16	# SET

371	370	list [catch {
372	371	eval [list $lset a [list 2a2] w]
373	372	} msg] $msg
374		} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
	373	} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}}
375	374
376	375	test lset-4.3 {lset, not compiled, 3 args, index out of range} {
377	376	set a {x y z}

406	405	list [catch {
407	406	eval [list $lset a 2a2 w]
408	407	} msg] $msg
409		} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
	408	} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}}
410	409
411	410	test lset-4.9 {lset, not compiled, 3 args, index out of range} {
412	411	set a {x y z}

542	541	test lset-8.3 {lset, not compiled, bad second index} {
543	542	set a {{b c} {d e}}
544	543	list [catch {eval [list $lset a 0 2a2 f]} msg] $msg
545		} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
	544	} {1 {bad index "2a2": must be intexpr or end?[+-]intexpr?}}
546	545
547	546	test lset-8.5 {lset, not compiled, second index out of range} {
548	547	set a {{b c} {d e} {f g}}

1269	1268	set i 25
1270	1269	incr i 000012345 ;# a decimal literal
1271	1270	} 12370
1272		test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
	1271	test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body {
1273	1272	set i 25
1274		catch {incr i 1a} msg
1275		set msg
1276		} {expected integer but got "1a"}
	1273	incr i 1a
	1274	} -returnCodes error -match glob -result {expected integer *but got "1a"}
1277	1275
1278	1276	test incr-1.25 {TclCompileIncrCmd: too many arguments} {
1279	1277	set i 10

1282	1280	} {wrong # args: should be "incr varName ?increment?"}
1283	1281
1284	1282
1285		test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
	1283	test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body {
1286	1284	set x " - "
1287		list [catch {incr x 1} msg] $msg
1288		} {1 {expected integer but got " - "}}
	1285	incr x 1
	1286	} -returnCodes error -match glob -result {expected integer *but got " - "}
1289	1287
1290	1288	test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
1291	1289	catch {unset array}

1488	1486	set i 25
1489	1487	$z i 000012345 ;# an octal literal
1490	1488	} 12370
1491		test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
	1489	test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body {
1492	1490	set z incr
1493	1491	set i 25
1494		catch {$z i 1a} msg
1495		set msg
1496		} {expected integer but got "1a"}
	1492	$z i 1a
	1493	} -returnCodes error -match glob -result {expected integer *but got "1a"}
1497	1494
1498	1495	test incr-2.25 {incr command (not compiled): too many arguments} {
1499	1496	set z incr

1502	1499	set msg
1503	1500	} {wrong # args: should be "incr varName ?increment?"}
1504	1501
1505		test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
	1502	test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body {
1506	1503	set z incr
1507	1504	set x " - "
1508		list [catch {$z x 1} msg] $msg
1509		} {1 {expected integer but got " - "}}
	1505	$z x 1
	1506	} -returnCodes error -match glob -result {expected integer *but got " - "}
1510	1507
1511	1508	################################################################################
1512	1509	# LLENGTH

1557	1554	test lindex-2.4 {malformed index list} {
1558	1555	set x \{
1559	1556	list [catch { eval [list $lindex {a b c} $x] } result] $result
1560		} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
	1557	} {1 bad\ index\ \"\{\":\ must\ be\ intexpr\ or\ end?\[+-\]intexpr?}
1561	1558
1562	1559	# Indices that are integers or convertible to integers
1563	1560

1616	1613	test lindex-4.8 {bad integer, not octal} {
1617	1614	set x end-0a2
1618	1615	list [catch { eval [list $lindex {a b c} $x] } result] $result
1619		} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
	1616	} {1 {bad index "end-0a2": must be intexpr or end?[+-]intexpr?}}
1620	1617
1621	1618	#test lindex-4.9 {incomplete end} {
1622	1619	# set x en

1626	1623	test lindex-4.10 {incomplete end-} {
1627	1624	set x end-
1628	1625	list [catch { eval [list $lindex {a b c} $x] } result] $result
1629		} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
	1626	} {1 {bad index "end-": must be intexpr or end?[+-]intexpr?}}
1630	1627
1631	1628	test lindex-5.1 {bad second index} {
1632	1629	list [catch { eval [list $lindex {a b c} 0 0a2] } result] $result
1633		} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
	1630	} {1 {bad index "0a2": must be intexpr or end?[+-]intexpr?}}
1634	1631
1635	1632	test lindex-5.2 {good second index} {
1636	1633	eval [list $lindex {{a b c} {d e f} {g h i}} 1 2]

1680	1677	test lindex-10.4 {malformed index list} {
1681	1678	set x \{
1682	1679	list [catch { lindex {a b c} $x } result] $result
1683		} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
	1680	} {1 bad\ index\ \"\{\":\ must\ be\ intexpr\ or\ end?\[+-\]intexpr?}
1684	1681
1685	1682	# Indices that are integers or convertible to integers
1686	1683

1760	1757	test lindex-12.8 {bad integer, not octal} {
1761	1758	set x end-0a2
1762	1759	list [catch { lindex {a b c} $x } result] $result
1763		} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
	1760	} {1 {bad index "end-0a2": must be intexpr or end?[+-]intexpr?}}
1764	1761
1765	1762	test lindex-12.10 {incomplete end-} {
1766	1763	set x end-
1767	1764	list [catch { lindex {a b c} $x } result] $result
1768		} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
	1765	} {1 {bad index "end-": must be intexpr or end?[+-]intexpr?}}
1769	1766
1770	1767	test lindex-13.1 {bad second index} {
1771	1768	list [catch { lindex {a b c} 0 0a2 } result] $result
1772		} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
	1769	} {1 {bad index "0a2": must be intexpr or end?[+-]intexpr?}}
1773	1770
1774	1771	test lindex-13.2 {good second index} {
1775	1772	catch {

1836	1833	test lindex-17.1 {no index} {
1837	1834	lindex {a b c}
1838	1835	} {a b c}
	1836
	1837	test lindex-18.1 {multiple +n} {
	1838	lindex {a b c d e f g} 1+1+1
	1839	} {d}
	1840
	1841	test lindex-18.2 {multiple +n/-n} {
	1842	lindex {a b c d e f g} 1+2-1
	1843	} {c}
	1844
	1845	test lindex-18.3 {end + multiple +n/-n} {
	1846	lindex {a b c d e f g} end-1-1
	1847	} {e}
	1848
	1849	test lindex-18.3 {end + multiple +n/-n} {
	1850	lindex {a b c d e f g} end-3+1
	1851	} {e}
	1852
	1853	test lindex-18.4 {multiple +/- in error} -body {
	1854	lindex {a b c d e f g} 1-x+3
	1855	} -returnCodes error -match glob -result "bad index*"
	1856
	1857	test lindex-18.5 {multiple +/- in error} -body {
	1858	lindex {a b c d e f g} 2-1+4x
	1859	} -returnCodes error -match glob -result "bad index*"
	1860
	1861	test lindex-18.6 {multiple +/- in error} -body {
	1862	lindex {a b c d e f g} end-3x-1
	1863	} -returnCodes error -match glob -result "bad index*"
1839	1864
1840	1865	catch { unset lindex}
1841	1866	catch { unset minus }

1950	1975	catch {unset x}
1951	1976	foreach {12.0} {a b c} {
1952	1977	set x 12.0
1953		set x [expr $x + 1]
	1978	set x [expr {$x + 1}]
1954	1979	}
1955	1980	set x
1956	1981	} 13.0

2024	2049	} {1 {wrong # args: should be "string last subString string ?index?"}}
2025	2050	test string-7.2 {string last, bad args} {
2026	2051	list [catch {string last a b c} msg] $msg
2027		} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
	2052	} {1 {bad index "c": must be intexpr or end?[+-]intexpr?}}
2028	2053	test string-7.3 {string last, too many args} {
2029	2054	list [catch {string last a b c d} msg] $msg
2030	2055	} {1 {wrong # args: should be "string last subString string ?index?"}}

2500	2525	list [catch {switch -foo a b c} msg] $msg
2501	2526	} {1 {bad option "-foo": must be -exact, -glob, -regexp, -command procname or --}}
2502	2527
	2528	test switch-3.8 {switch -regexp with option-like pattern} regexp {
	2529	switch -regexp -- -def {
	2530	-abc {concat first}
	2531	-def {concat second}
	2532	-ghi {concat third}
	2533	default {concat none}
	2534	}
	2535	} second
	2536
2503	2537	test switch-4.1 {error in executed command} {
2504	2538	list [catch {switch a a {error "Just a test"} default {expr 1}} msg] \
2505	2539	$msg

3339	3373	test range-2.0 {foreach range test} {
3340	3374	set k 0
3341	3375	foreach {x y} [range 100] {
3342		incr k [expr {$x*$y}]
	3376	incr k [expr {$x*$y}]
3343	3377	}
3344	3378	set k
3345	3379	} {164150}

3348	3382	set k 0
3349	3383	set trash {}
3350	3384	foreach {x y} [range 100] {
3351		incr k [expr {$x*$y}]
3352		lappend trash $x $y
	3385	incr k [expr {$x*$y}]
	3386	lappend trash $x $y
3353	3387	}
3354	3388	set trash {}
3355	3389	set k

3358	3392	test range-2.2 {range element shimmering test} {
3359	3393	set k {}
3360	3394	foreach x [range 0 10] {
3361		append k [llength $x]
	3395	append k [llength $x]
3362	3396	}
3363	3397	set k
3364	3398	} {1111111111}

3384	3418	set trash {}
3385	3419	set r [range 100]
3386	3420	for {set i 0} {$i < [llength $r]} {incr i 2} {
3387		incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
	3421	incr k [expr {[lindex $r $i]*[lindex $r [expr {$i+1}]]}]
3388	3422	}
3389	3423	set trash {}
3390	3424	set k
3391	3425	} {164150}
	3426
	3427	test range-6.1 {range} -body {
	3428	range
	3429	} -returnCodes error -result {wrong # args: should be "range ?start? end ?step?"}
	3430
	3431	test range-6.2 {range} -body {
	3432	range foo
	3433	} -returnCodes error -match glob -result {expected integer *but got "foo"}
	3434
	3435	test range-6.3 {range} -body {
	3436	range 2 bar
	3437	} -returnCodes error -match glob -result {expected integer *but got "bar"}
	3438
	3439	test range-6.4 {range} -body {
	3440	range 2 4 foo
	3441	} -returnCodes error -match glob -result {expected integer *but got "foo"}
	3442
	3443	test range-6.5 {range} -body {
	3444	range 10 0
	3445	} -returnCodes error -result {Invalid (infinite?) range specified}
	3446
	3447	test range-6.6 {range} -body {
	3448	range 2 4 0
	3449	} -returnCodes error -result {Invalid (infinite?) range specified}
	3450
	3451	test range-6.7 {range} -body {
	3452	range 2 4 -2
	3453	} -returnCodes error -result {Invalid (infinite?) range specified}
3392	3454
3393	3455	################################################################################
3394	3456	# SCOPE

3469	3531	} {200}
3470	3532
3471	3533	catch {unset sum; unset err; unset i}
	3534
	3535	################################################################################
	3536	# ENV
	3537	################################################################################
	3538	test env-1.1 {env} -body {
	3539	env abc def ghi
	3540	} -returnCodes error -result {wrong # args: should be "env varName ?default?"}
	3541
	3542	test env-1.2 {env} -body {
	3543	env DOES_NOT_EXIST abc
	3544	} -result {abc}
	3545
	3546	test env-1.3 {env} -body {
	3547	env DOES_NOT_EXIST
	3548	} -returnCodes error -result {environment variable "DOES_NOT_EXIST" does not exist}
	3549
	3550	################################################################################
	3551	# READDIR
	3552	################################################################################
	3553	test readdir-1.1 {readdir usage} -body {
	3554	readdir
	3555	} -returnCodes error -result {wrong # args: should be "readdir ?-nocomplain? dirPath"}
	3556
	3557	test readdir-1.2 {readdir basic} -body {
	3558	expr {"jim.test" in [readdir [file dirname [info script]]]}
	3559	} -result {1}
	3560
	3561	test readdir-1.3 {readdir basic} -body {
	3562	expr {"jim.test" in [readdir -nocomplain [file dirname [info script]]]}
	3563	} -result {1}
	3564
	3565	test readdir-1.4 {readdir errors} -body {
	3566	readdir nonexistent
	3567	} -returnCodes error -result {No such file or directory}
	3568
	3569	test readdir-1.4 {readdir -nocomplain} -body {
	3570	readdir -nocomplain nonexistent
	3571	} -result {}
	3572
3472	3573
3473	3574	################################################################################
3474	3575	# JIM REGRESSION TESTS

+27

-0

tests/jiminterp.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3	needs cmd interp
	4
	5	test interp-1.0 {interp bad args} -body {
	6	interp arg
	7	} -returnCodes error -result {wrong # args: should be "interp"}
	8
	9	test interp-1.1 {interp alias} {
	10	set i [interp]
	11	$i alias subincr incr
	12	$i eval { set x 0 }
	13	$i eval { subincr x }
	14	$i eval { subincr x }
	15	} {2}
	16
	17	test interp-1.2 {interp alias delete} {
	18	$i eval { rename subincr "" }
	19	} {}
	20
	21	test interp-1.3 {interp delete } {
	22	$i alias subincr2 incr
	23	$i delete
	24	} {}
	25
	26	testreport

+56

-0

tests/jimsh.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3
	4	test jimsh-1.1 {jimsh --help} -body {
	5	exec [info nameofexecutable] --help
	6	} -match glob -result {jimsh version Usage: }
	7
	8	test jimsh-1.2 {jimsh -} {
	9	exec [info nameofexecutable] - << {puts $(1 + 2)}
	10	} {3}
	11
	12	test jimsh-1.3 {jimsh - arg list} jim {
	13	exec [info nameofexecutable] - arg list << {puts [join $argv]}
	14	} {arg list}
	15
	16	test jimsh-1.4 {jimsh -e} {
	17	exec [info nameofexecutable] -e {expr {4 + 5}}
	18	} {9}
	19
	20	test jimsh-1.4 {jimsh -e with args} {
	21	exec [info nameofexecutable] -e {set argv} arg1 arg2
	22	} {arg1 arg2}
	23
	24	test jimsh-1.5 {jimsh --version} {
	25	exec [info nameofexecutable] --version
	26	} [info version]
	27
	28	test jimsh-1.6 {jimsh -e with error} -body {
	29	exec [info nameofexecutable] -e blah
	30	} -returnCodes error -result {invalid command name "blah"}
	31
	32	test jimsh-1.7 {jimsh prompt} -body {
	33	exec [info nameofexecutable] << "set x 3\nincr x\nexit \$x\n"
	34	} -returnCodes error -match glob -result {Welcome to Jim version *
	35	. 3
	36	. 4
	37	. }
	38
	39	test jimsh-1.8 {jimsh prompt - error} -body {
	40	exec [info nameofexecutable] << "blah\n"
	41	} -match glob -result {Welcome to Jim version *
	42	. invalid command name "blah"
	43	\[error\] . }
	44
	45	test jimsh-1.9 {jimsh prompt - error} -body {
	46	exec [info nameofexecutable] << "throw 99\n"
	47	} -match glob -result {Welcome to Jim version *
	48	. \[99\] . }
	49
	50	test jimsh-1.10 {jimsh prompt - continuation} -body {
	51	exec [info nameofexecutable] << "set x {\nabc\n}\n"
	52	} -match glob -result "Welcome to Jim version *\n. {> {> \nabc\n\n. "
	53
	54
	55	testreport

+51

-0

tests/key.pem less more

	0	-----BEGIN RSA PRIVATE KEY-----
	1	MIIJKgIBAAKCAgEA0T9HMb5b2WZDIAF7+7KZzwAEiXC5misVrY1gmlwvLlSVx1pX
	2	Kx5KrFpwkBMfDs1Zsi03/D46N+kViOmSJY/h5nxpiTdbs1Gld2b1RqFbnXcLmx7e
	3	WVXXouLDcmzoJM1Y7vh26e9j3Uy4Bsew7zfxgnWmbfOA9Sg/rHamQFfJ+Ov9Nglk
	4	AoGPwdIiDWc4+hkKD6HL3B72m3VyD4crDSuTm2vFqUDhXk+Jw3clNQYXHQrOSpDK
	5	st1qPQtEDTQbrmKhSN6jMBRwcwfo39lCZLN02jEfOC2bwHPe+VgcyfCzWgfKHtPl
	6	hqqanSIndDSAc6aF5hzI1vlT2dZNmSWDZ6QBrwharh25QXcnQhDr/9DyHIjgvojR
	7	OsOiSaT4pVvJRBsVm7N/7kVQKvNdbwB8itz+ubLlb5SYahlZNBMpE9RqgchwAwe0
	8	SpjILMBHI90/H89SrZPZ4rMitZiIq5/3mBFEy/7Xio/G5jw/Gp3cHa6SMf/6cqhl
	9	l7binB8s8Yd5c8RvdNunczCobKmbnTMDRdsnjnvWFmiaPJZUdcOtftxUCxYP2tEj
	10	apQL8kjC+K4MjCGkde/5lrd8+yRY6GK6zixxfYb1jka/NFdXBaws4gm8amrsFstk
	11	Y3K2GqrVh44/sG7BNqsl4hxkqyHryay7B413+KUrkiET4PqwSHgtJHPayAMCAwEA
	12	AQKCAgEApOLjPCyP/jkaLg9dXtK3ZynRaWh9qSHIXFFqzVhVCYI34Last9qP508B
	13	IlcfAzAIPWJqmoeCouo2QQQlWRoPXeut0iXgSebNp9Bm+ThPlD7p01u4xNbjLITa
	14	lMGDEPUL3ovGUMOGgy1gWl9jaq4/zpjdBAl9FjKYMlPw4AUNr+xuRPWTbHIiEQ6A
	15	LOWpPVMb3YOWvCdeFtSug9P0tdUf5LpBMQViUkoE+hVaKXVaI1WPh6yfPeFCRUYq
	16	Yukr4vfvthdSqqGAlvSlqjdunSHYs9M/kapG8JmeHAg171+QRSKcQDyjwsGPQsFW
	17	K7jve7K+Er2d+eDRFXhM/6BS8wmHFLP5BtHY/XCCZdjcJShIrGWK/Arepzh5TPpe
	18	lIriZBzFBdtLNDaVs0Fj7C+r5ERYulgrF8gwEfPXxFen4vp4gjP3fRnApXgLfEGu
	19	2Cj7SR62nZrRWKBuOYhaoVGt1zdoP7mmcL32/Kg78ItteaNXG07ICogXBoTl0Tj0
	20	N0wPpFG280amcJLB2tSwYyiIF53XyNazKxhgpBHnt1/y+peQfZadncQ/nImmM0f6
	21	GTql3ToEMKj9V3nrYUQhRVEmltCrfJA8pVjFJkp0AjlyZOf/FgcSFNvWbdn0t6vE
	22	EOPU6RklpK0X0Go7B3ywOEqAu51oxo0QgUdRe6v2nzv7Xeuh9FkCggEBAPUV6JTg
	23	uqjWxq7XNA3RljCy8NPzTsT7AS7XwLBD/+JcICXjQQ2SVqMzx7SftGucGw6/8GKx
	24	HRXwp67k73iifiiQ7f1xOsXXgVs7aDg1MT7UE9KOVuY0r74P3No13nSfNYzOMBjh
	25	a+FqKO5v8yjZjNwT5ghtHluJqXPQPMeKYzR3ngNlFRzW9cfDQspiHdTSpu9gFE02
	26	iSug9SNxMjRDiWsqBC14qu3S3ynaU5UuKhqw5CVSRj/Y7pN94b01tVXe4Szcf/U0
	27	HXzg33jlf1QshwsdcBXcGpkB5ijtp6koQuAKRHjxeqcpMKIPpxzratlWBPeynvX7
	28	xO+bDultW4z8tr0CggEBANqQy30ZMM64v39bo04cQNrIMJd2ez1c/lqysneQwIuK
	29	1ALfRJbN74/Zy+vlx9VH6tKT2i5o1FP1Nd5BKiRGLd3bTLE+UlweUWrZoJbyz7ns
	30	IuLqGhw9Qy9SaqCfSyGu9Lmn8blCMVDPf1AggB4fuFHhiT+aBK1AidzDM/Usar2H
	31	D2HwfWP3tKARcyzBnWExiDncUau8oRFdfsYL72kb2P3RvtDtsMRLSFHOdd88o1Us
	32	LSQ+T36U3A2UKCteBndBguN+N7zyUNk7DVpfXILKmFj9nDmoYOFsnctG+TYbRmfr
	33	7G/wKDcEtrmK0tpSOLF5QvowO3qDYaYYYGdK5EPbxb8CggEACDRtjt5fIVvfVucZ
	34	dQT5NDQpX88bafjFN149syjzng5bfSk4ek3V3KzVGLToA1o8hafjUkp/oMZntrEv
	35	WyiFdLI1ZXCu+QSX7gf1Gzyco2/SIhBl1FsbLw+04xE+m0ThNA+LCKozRF6bdDAH
	36	QezWjF+WKd4NUB8xrxDfmAaH/6+peI+fv1Fq9P8Sc1gJi6BpukXLKDKVMQK4cjFN
	37	7vX72byUWzlY75FJq0sF1U6wVihp2t4AQA7xHbrvHbh4k6FchHX1Sq4t9opIsPFt
	38	69F5y+N2ZyTxNwIbRG+AV2djpcByPmJHKuV0HVjMzWkMMK5yiCBQtgdxtlvIigQB
	39	Np0XOQKCAQEAw6yYEUJpONmbz/iJppeS1IwfPKq9QL2tliOftX2pdARxNLUQYfay
	40	v9WcRHBuTJrbN3VZAu2lEhlZBcbPZLRTwejgq1oBQCmAeKmnpRxzLp+iyAYQJDIQ
	41	oSAnB/A0wk4xGLmrplEFd7Sc5W6DZPS+/sdtKbzI7Rb3leZI8Pm4AkAVXHiCuen9
	42	EsUsmOgp7ub6b9q4X4k7piFPKx1qVG6zAOIz9DaoZ8SCVYMCcj6Gd+1Z6LXEU64P
	43	qDR5FgJSxZeoB+VrH0TNbv34QW1YlFuusxUyNUhym76zMlczK+aVTNqhzcFzL3aP
	44	5GLNzNmJmhHXDcf6p/9Rf/MY88DPxZTPXwKCAQEAt2cxXMiEWfFwWHufqpahl3Aq
	45	C4yf0EFMhBsOmnDYZ4RDYikFGJog7XY+BOEX0NZ2z2ZghwjmQW/Gm14ISQnww97d
	46	uo/MDuUZvf6aAeh6gRmkiejhIXMwuvxRAwm90TFUiJ4yn8LKp2c1XxX8DMHujlzS
	47	cdUKcFO3OL+eLQazM5M+3qxQuAFDTlBf41d3OJjCOuQ9soBy0Gy9yMhtjFVVmKDw
	48	eArA0lZgskLVcI9JH6bPhv7+5+n26OqMlFjtmbNMwqi/lOoyGwst5b2d9oAMkWQi
	49	QW5pi51MaAwVV8q8NdfUv1twD8lpRV8Rwb2k8rmG5FqSwhOsibSwpu8gf4WYow==
	50	-----END RSA PRIVATE KEY-----

-2

tests/linsert.test less more

81	81	} {1 {wrong # args: should be "linsert list index ?element ...?"}}
82	82	test linsert-2.2 {linsert errors} {
83	83	list [catch {linsert a b} msg] $msg
84		} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
	84	} {1 {bad index "b": must be intexpr or end?[+-]intexpr?}}
85	85	test linsert-2.3 {linsert errors} {
86	86	list [catch {linsert a 12x 2} msg] $msg
87		} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
	87	} {1 {bad index "12x": must be intexpr or end?[+-]intexpr?}}
88	88	test linsert-2.4 {linsert errors} tcl {
89	89	list [catch {linsert \{ 12 2} msg] $msg
90	90	} {1 {unmatched open brace in list}}

-2

tests/list.test less more

82	82
83	83	proc slowsort list {
84	84	set result {}
85		set last [expr [llength $list] - 1]
	85	set last [expr {[llength $list] - 1}]
86	86	while {$last > 0} {
87		set minIndex [expr [llength $list] - 1]
	87	set minIndex [expr {[llength $list] - 1}]
88	88	set min [lindex $list $last]
89	89	set i [expr $minIndex-1]
90	90	while {$i >= 0} {

109	109	slowsort {fred julie alex carol bill annie}
110	110	} {alex annie bill carol fred julie}
111	111
	112	test list-4.1 {lreverse} {
	113	lreverse {}
	114	} {}
	115	test list-4.2 {lreverse} {
	116	lreverse {1 2 3}
	117	} {3 2 1}
	118
112	119	testreport

+109

-0

tests/load.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs cmd load interp
	3
	4	# In order to test loadable modules we need a working build-jim-ext
	5	# (from the same directory as jimsh).
	6	# If we don't have that, just skip these tests.
	7
	8	set buildjimext [file join [file dirname [info nameofexecutable]] build-jim-ext]
	9	# loadtest.c is in the same directory as this script
	10	set src [file join [file dirname [info script]] loadtest.c]
	11
	12	set skip 1
	13	if {[file exec $buildjimext]} {
	14	set skip [catch {
	15	exec $buildjimext $src
	16	}]
	17	if {!$skip && ![file exists loadtest.so]} {
	18	set skip 1
	19	}
	20	}
	21	if {$skip} {
	22	skiptest " (no working build-jim-ext)"
	23	}
	24
	25	test load-1.0 {load usage} -body {
	26	load
	27	} -returnCodes error -result {wrong # args: should be "load libraryFile"}
	28
	29	# Now everything is done in a child interpreter so that
	30	# because loadable modules only get unloaded on interpreter exit
	31	test load-1.1 {load initial} {
	32	set interp [interp]
	33	$interp eval {exists -command loadtest}
	34	} {0}
	35
	36	test load-1.2 {create loadable extension} -body {
	37	exec $buildjimext $src
	38	file exists loadtest.so
	39	} -result {1}
	40
	41	test load-1.3 {load dynamic extension} -body {
	42	$interp eval {
	43	load loadtest.so
	44	exists -command loadtest
	45	}
	46	} -result {1}
	47
	48	test load-1.4 {run dynamic extension command} -body {
	49	$interp eval {
	50	loadtest test abc
	51	}
	52	} -result {abc}
	53
	54	test load-1.5 {load invalid dynamic extension} -body {
	55	$interp eval {
	56	load nonexistent
	57	}
	58	} -returnCodes error -match glob -result {error loading extension "nonexistent": *}
	59
	60	$interp delete
	61
	62	test load-1.6 {load via package require} {
	63	set interp [interp]
	64	$interp eval {
	65	lappend auto_path [pwd]
	66	package require loadtest
	67	exists -command loadtest
	68	}
	69	} {1}
	70
	71	$interp delete
	72
	73	test load-2.1 {loadable extension with full path} -body {
	74	set interp [interp]
	75	exec $buildjimext $src
	76	$interp eval {
	77	load [pwd]/loadtest.so
	78	loadtest test def
	79	}
	80	} -result {def} -cleanup {
	81	$interp delete
	82	}
	83
	84	test load-2.2 {loadable extension without extension} -body {
	85	set interp [interp]
	86	file rename loadtest.so loadtest
	87	$interp eval {
	88	load loadtest
	89	loadtest test def
	90	}
	91	} -result {def} -cleanup {
	92	$interp delete
	93	file delete loadtest
	94	}
	95
	96	test load-2.1 {loadable extension with no entrypoint} -body {
	97	set interp [interp]
	98	exec $buildjimext --notest -DNO_ENTRYPOINT $src
	99	$interp eval {
	100	load loadtest.so
	101	}
	102	} -returnCodes error -result {No Jim_loadtestInit symbol found in extension loadtest.so} -cleanup {
	103	$interp delete
	104	}
	105
	106	file delete loadtest.so
	107
	108	testreport

+36

-0

tests/loadtest.c less more

	0	#include <jim.h>
	1	#include <jim-subcmd.h>
	2
	3	static int loadtest_cmd_test(Jim_Interp interp, int argc, Jim_Obj const *argv)
	4	{
	5	Jim_SetResult(interp, argv[0]);
	6	return JIM_OK;
	7	}
	8
	9	static const jim_subcmd_type loadtest_command_table[] = {
	10	{ "test",
	11	"arg",
	12	loadtest_cmd_test,
	13	1,
	14	1,
	15	},
	16	{ NULL }
	17	};
	18
	19	static int loadtest_cmd(Jim_Interp interp, int argc, Jim_Obj const *argv)
	20	{
	21	return Jim_CallSubCmd(interp, Jim_ParseSubCmd(interp, loadtest_command_table, argc, argv), argc, argv);
	22	}
	23
	24	#ifndef NO_ENTRYPOINT
	25	int Jim_loadtestInit(Jim_Interp *interp)
	26	{
	27	if (Jim_PackageProvide(interp, "loadtest", "1.0", JIM_ERRMSG)) {
	28	return JIM_ERR;
	29	}
	30
	31	Jim_CreateCommand(interp, "loadtest", loadtest_cmd, 0, 0);
	32
	33	return JIM_OK;
	34	}
	35	#endif

-0

tests/loop.test less more

74	74	set a
75	75	} {}
76	76
	77	test loop-1.11 {no start} {
	78	set a {}
	79	loop i 5 {
	80	lappend a $i
	81	}
	82	set a
	83	} {0 1 2 3 4}
	84
77	85	test loop-2.1 {loop shimmering tests} {
78	86	loop i 1 6 {
79	87	}

-2

tests/lrange.test less more

68	68	} {1 {wrong # args: should be "lrange list first last"}}
69	69	test lrange-2.3 {error conditions} {
70	70	list [catch {lrange a b 6} msg] $msg
71		} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
	71	} {1 {bad index "b": must be intexpr or end?[+-]intexpr?}}
72	72	test lrange-2.4 {error conditions} {
73	73	list [catch {lrange a 0 enigma} msg] $msg
74		} {1 {bad index "enigma": must be integer?[+-]integer? or end?[+-]integer?}}
	74	} {1 {bad index "enigma": must be intexpr or end?[+-]intexpr?}}
75	75	test lrange-2.5 {error conditions} tcl {
76	76	list [catch {lrange "a \{b c" 3 4} msg] $msg
77	77	} {1 {unmatched open brace in list}}

-3

tests/lreplace.test less more

115	115	} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
116	116	test lreplace-2.3 {lreplace errors} {
117	117	list [catch {lreplace x a 10} msg] $msg
118		} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
	118	} {1 {bad index "a": must be intexpr or end?[+-]intexpr?}}
119	119	test lreplace-2.4 {lreplace errors} {
120	120	list [catch {lreplace x 10 x} msg] $msg
121		} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
	121	} {1 {bad index "x": must be intexpr or end?[+-]intexpr?}}
122	122	test lreplace-2.5 {lreplace errors} {
123	123	list [catch {lreplace x 10 1x} msg] $msg
124		} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
	124	} {1 {bad index "1x": must be intexpr or end?[+-]intexpr?}}
125	125	test lreplace-2.6 {lreplace errors} {
126	126	list [catch {lreplace x 3 2} msg] $msg
127	127	} {0 x}

+121

-0

tests/lsearch.test less more

71	71	lsearch -nocase -glob {b.x ^bc xy bcx} B*
72	72	} 0
73	73
	74	test lsearch-2.10 {regexp with option-looking pattern} regexp {
	75	lsearch -regexp {-abc -def -ghi} -def
	76	} 1
	77
	78	test lsearch-2.11 {regexp with option-looking pattern, -nocase} regexp {
	79	lsearch -nocase -regexp {-abc -def -ghi} -DEF
	80	} 1
	81
74	82	test lsearch-3.1 {lsearch errors} {
75	83	list [catch lsearch msg]
76	84	} {1}

178	186	lsearch -not -bool -glob -all -nocase {a1 a2 b1 b2 a3 b3} B*
179	187	} {1 1 0 0 1 0}
180	188
	189	test lsearch-17.1 {lsearch -index option, basic functionality} {
	190	lsearch -index 1 {{a c} {a b} {a a}} a
	191	} 2
	192	test lsearch-17.2 {lsearch -index option, basic functionality} {
	193	lsearch -index 1 -exact {{a c} {a b} {a a}} a
	194	} 2
	195	test lsearch-17.3 {lsearch -index option, basic functionality} {
	196	lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b*
	197	} 1
	198	test lsearch-17.4 {lsearch -index option, basic functionality} {
	199	lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
	200	} 0
	201	test lsearch-17.5 {lsearch -index option, basic functionality} {
	202	lsearch -all -index 0 -exact {{a c} {a b} {d a}} a
	203	} {0 1}
	204	test lsearch-17.6 {lsearch -index option, basic functionality} {
	205	lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b*
	206	} {1 2}
	207	test lsearch-17.7 {lsearch -index option, basic functionality} {
	208	lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
	209	} {0 1}
	210	test lsearch-17.8 {lsearch -index option, empty argument} {
	211	lsearch -index {} a a
	212	} 0
	213	test lsearch-17.9 {lsearch -index option, empty argument} {
	214	lsearch -index {} a a
	215	} [lsearch a a]
	216	test lsearch-17.10 {lsearch -index option, empty argument} {
	217	lsearch -index {} [list \{] \{
	218	} 0
	219	test lsearch-17.11 {lsearch -index option, empty argument} {
	220	lsearch -index {} [list \{] \{
	221	} [lsearch [list \{] \{]
	222	test lsearch-17.12 {lsearch -index option, encoding aliasing} -body {
	223	lsearch -index -2 a a
	224	} -returnCodes error -result {index "-2" out of range}
	225	test lsearch-17.13 {lsearch -index option, encoding aliasing} -body {
	226	lsearch -index -1-1 a a
	227	} -returnCodes error -result {index "-1-1" out of range}
	228	test lsearch-17.14 {lsearch -index option, encoding aliasing} -body {
	229	lsearch -index end--1 a a
	230	} -returnCodes error -result {index "end--1" out of range}
	231	test lsearch-17.15 {lsearch -index option, encoding aliasing} -body {
	232	lsearch -index end+1 a a
	233	} -returnCodes error -result {index "end+1" out of range}
	234	test lsearch-17.16 {lsearch -index option, encoding aliasing} -body {
	235	lsearch -index end+2 a a
	236	} -returnCodes error -result {index "end+2" out of range}
	237
	238	test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
	239	lsearch -index 2 {{a c} {a b} {a a}} a
	240	} -returnCodes error -result {element 2 missing from sublist "a c"}
	241	test lsearch-20.2 {lsearch -index option, malformed index} -body {
	242	lsearch -index foo {{a c} {a b} {a a}} a
	243	} -returnCodes error -match glob -result {bad index *}
	244
	245	test lsearch-23.1 {lsearch -stride option, errors} -body {
	246	lsearch -stride {a b} a
	247	} -returnCodes error -match glob -result {*}
	248	test lsearch-23.2 {lsearch -stride option, errors} -body {
	249	lsearch -stride 0 {a b} a
	250	} -returnCodes error -result {stride length must be at least 1}
	251	test lsearch-23.3 {lsearch -stride option, errors} -body {
	252	lsearch -stride 2 {a b c} a
	253	} -returnCodes error -result {list size must be a multiple of the stride length}
	254	test lsearch-23.4 {lsearch -stride option, errors} -body {
	255	lsearch -stride 5 {a b c} a
	256	} -returnCodes error -result {list size must be a multiple of the stride length}
	257	test lsearch-23.5 {lsearch -stride option, errors} -body {
	258	# Stride equal to length is ok
	259	lsearch -stride 3 {a b c} a
	260	} -result 0
	261
	262	test lsearch-24.1 {lsearch -stride option} -body {
	263	lsearch -stride 2 {a b c d e f g h} d
	264	} -result -1
	265	test lsearch-24.2 {lsearch -stride option} -body {
	266	lsearch -stride 2 {a b c d e f g h} e
	267	} -result 4
	268	test lsearch-24.3 {lsearch -stride option} -body {
	269	lsearch -stride 3 {a b c d e f g h i} e
	270	} -result -1
	271	test lsearch-24.4 {lsearch -stride option} -body {
	272	# Result points first in group
	273	lsearch -stride 3 -index 1 {a b c d e f g h i} e
	274	} -result 3
	275	test lsearch-24.5 {lsearch -stride option} -body {
	276	lsearch -inline -stride 2 {a b c d e f g h} d
	277	} -result {}
	278	test lsearch-24.6 {lsearch -stride option} -body {
	279	# Inline result is a "single element" strided list
	280	lsearch -inline -stride 2 {a b c d e f g h} e
	281	} -result "e f"
	282	test lsearch-24.7 {lsearch -stride option} -body {
	283	lsearch -inline -stride 3 {a b c d e f g h i} e
	284	} -result {}
	285	test lsearch-24.8 {lsearch -stride option} -body {
	286	lsearch -inline -stride 3 -index 1 {a b c d e f g h i} e
	287	} -result "d e f"
	288	test lsearch-24.9 {lsearch -stride option} -body {
	289	lsearch -all -inline -stride 3 -index 1 {a b c d e f g e i} e
	290	} -result "d e f g e i"
	291	test lsearch-24.10 {lsearch -stride option} -body {
	292	lsearch -all -inline -stride 3 -index 0 {a b c d e f a e i} a
	293	} -result "a b c a e i"
	294	test lsearch-24.11 {lsearch -stride option} -body {
	295	# Stride 1 is same as no stride
	296	lsearch -stride 1 {a b c d e f g h} d
	297	} -result 3
	298	test lsearch-24.12 {lsearch -stride -index with missing elements} -body {
	299	lsearch -stride 1 -index {1 1} {a b c} c
	300	} -returnCodes error -result {element 1 missing from sublist "a"}
	301
181	302	testreport

+39

-11

tests/lsort.test less more

16	16	} {1 {wrong # args: should be "lsort ?options? list"}}
17	17	test lsort-1.2 {Tcl_LsortObjCmd procedure} jim {
18	18	list [catch {lsort -foo {1 3 2 5}} msg] $msg
19		} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, -nocase, -real, or -unique}}
	19	} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, -nocase, -real, -stride, or -unique}}
20	20	test lsort-1.3 {Tcl_LsortObjCmd procedure, default options} {
21	21	lsort {d e c b a \{ d35 d300}
22	22	} {a b c d d300 d35 e \{}

50	50	} {1 {"-index" option must be followed by list index}}
51	51	test lsort-1.12 {Tcl_LsortObjCmd procedure, -index option} {
52	52	list [catch {lsort -index foo {1 3 2 5}} msg] $msg
53		} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
	53	} {1 {bad index "foo": must be intexpr or end?[+-]intexpr?}}
54	54	test lsort-1.13 {Tcl_LsortObjCmd procedure, -index option} {
55	55	lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
56	56	} {1 {2 25} {3 16 42} {10 20 50 100}}

130	130	test lsort-3.2 {lsort -real, returning indices} {
131	131	lsort -decreasing -real {1.2 34.5 34.5 5.6}
132	132	} {34.5 34.5 5.6 1.2}
133		test lsort-3.3 {SortCompare procedure, -index option} jim {
134		list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg
135		} {1 {list index out of range}}
136		test lsort-3.5 {SortCompare procedure, -index option} jim {
137		list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg
138		} {1 {list index out of range}}
	133	test lsort-3.3 {SortCompare procedure, -index option} -body {
	134	lsort -integer -index 2 {{20 10} {15 30 40}}
	135	} -returnCodes error -result {element 2 missing from sublist "20 10"}
	136	test lsort-3.5 {SortCompare procedure, -index option} -body {
	137	lsort -integer -index 2 {{20 10 13} {15}}
	138	} -returnCodes error -result {index "2" out of range}
139	139	test lsort-3.6 {SortCompare procedure, -index option} {
140	140	lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
141	141	} {{3 25 20} {2 5 25} {1 15 30}}

201	201	set vallist
202	202	} {0 4 5}
203	203
204		test lsort-4.26 {DefaultCompare procedure, signed characters} utf8 {
205		lsort [list "abc\u80" "abc"]
206		} [list "abc" "abc\u80"]
207	204
208	205	test lsort-5.1 "Sort case insensitive" {
209	206	lsort -nocase {ba aB aa ce}
210	207	} {aa aB ba ce}
211	208
	209	test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} {
	210	lsort -stride 2 {f e d c b a}
	211	} {b a d c f e}
	212	test cmdIL-1.31 {Tcl_LsortObjCmd procedure, -stride option} {
	213	lsort -stride 3 {f e d c b a}
	214	} {c b a f e d}
	215	test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body {
	216	lsort -stride foo bar
	217	} -result {expected integer but got "foo"}
	218	test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body {
	219	lsort -stride 1 bar
	220	} -result {stride length must be at least 2}
	221	test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body {
	222	lsort -stride 2 {a b c}
	223	} -result {list size must be a multiple of the stride length}
	224	test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body {
	225	lsort -stride 2 -index 3 {a b c d}
	226	} -match glob -result {*}
	227	test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
	228	lsort -stride 2 -index {0 1} {
	229	{{c o d e} 54321} {{b l a h} 94729}
	230	{{b i g} 12345} {{d e m o} 34512}
	231	}
	232	} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
	233	test cmdIL-1.41 {lsort -stride and -index} -body {
	234	lsort -stride 2 -index -2 {a 2 b 1}
	235	} -returnCodes error -result {index "-2" out of range}
	236	test cmdIL-1.42 {lsort -stride and-index} -body {
	237	lsort -stride 2 -index -1-1 {a 2 b 1}
	238	} -returnCodes error -result {index "-1-1" out of range}
	239
212	240	testreport

+15

-10

tests/misc.test less more

287	287
288	288	test catch-1.7 "catch exit" {
289	289	# Normally exit would not be caught
290		dict get [info returncodes] [catch -exit {exit 5} result]
291		} {exit}
	290	list [dict get [info returncodes] [catch -exit {exit 5} result]] $result
	291	} {exit 5}
292	292
293	293	test catch-1.8 "catch error has -errorinfo" {
294	294	set rc [catch {set undefined} msg opts]

305	305	proc b {} { catch {a} msg opts; return {*}$opts $msg }
306	306	set rc [catch {b} msg opts]
307	307	list $rc $msg [llength $opts(-errorinfo)]
308		} {1 {from a} 6}
	308	} {1 {from a} 9}
309	309
310	310	test return-1.2 "error can rethrow an error" {
311	311	proc a {} { error "from a" }

526	526	list $a(3) $a
527	527	} {4 {3 4}}
528	528
529		test jim-badvar-1.1 "invalid variable name" {
	529	test jim-badvar-1.1 "variable name with embedded null" {
530	530	set x b\0c
531		catch {set $x 5}
532		} 1
533
534		test jim-badvar-1.2 "incr invalid variable name" {
	531	set $x 5
	532	} 5
	533
	534	test jim-badvar-1.2 "incr variable name with embedded null" {
535	535	set x b\0c
536		catch {incr $x}
537		} 1
	536	incr $x
	537	} 6
538	538
539	539	test lset-1.1 "lset with bad var" {
540	540	catch {lset badvar 1 x}
541	541	} 1
	542
	543	test lset-1.2 "lset error message" {
	544	catch lset msg
	545	set msg
	546	} {wrong # args: should be "lset listVar ?index ...? value"}
542	547
543	548	test dict-1.1 "dict to string" {
544	549	set a [dict create abc \\ def \"]

+32

-0

tests/namespace.test less more

137	137	variable x(3) y
138	138	}
139	139	} -returnCodes error -result {can't define "x(3)": name refers to an element in an array}
	140
	141
	142	test namespace-1.29 {namespace variable too many args} -body {
	143	namespace eval ns1 {
	144	variable x(3) y a b c
	145	}
	146	} -returnCodes error -result {wrong # args: should be "variable name ?value?"}
	147
	148	test namespace-1.30 {namespace current too many args} -body {
	149	namespace current a
	150	} -returnCodes error -result {wrong # args: should be "namespace current"}
	151
	152	# TODO: Add tests for canonical option
	153
	154	test namespace-1.31 {namespace canonical too many args} -body {
	155	namespace canonical a b c
	156	} -returnCodes error -result {wrong # args: should be "namespace canonical ?current? ?name?"}
	157
140	158
141	159	unset -nocomplain ns1::x ns1::y
142	160

285	303	[namespace parent nsh1::nsh2] \
286	304	[namespace parent nsh1::nsh2::nsh3a]
287	305	} {{} :: ::nsh1 ::nsh1::nsh2}
	306
	307	test namespace-5.22 {query namespace parent with fully qualified names} {
	308	list [namespace eval :: {namespace parent}] \
	309	[namespace eval ::nsh1 {namespace parent}] \
	310	[namespace eval ::nsh1::nsh2 {namespace parent}] \
	311	[namespace eval nsh1::nsh2::nsh3a {namespace parent ::nsh1::nsh2}] \
	312	} {{} :: ::nsh1 ::nsh1}
288	313
289	314	# -----------------------------------------------------------------------
290	315	# TEST: name resolution and caching

505	530	namespace delete one two three
506	531	} -returnCodes error -match glob -result {import pattern * would create a loop*}
507	532
	533	test namespace-12.4 {namespace import} {
	534	namespace eval ::test_ns_one {}
	535	proc ::test_ns_one::testcmd args { return 2 }
	536	namespace import ::test_ns_one::*
	537	testcmd
	538	} 2
	539
508	540	foreach cmd [info commands test_ns_*] {
509	541	rename $cmd ""
510	542	}

+116

-0

tests/pack.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs cmd pack
	3
	4	test pack-1.1 {pack usage} -body {
	5	pack
	6	} -returnCodes error -result {wrong # args: should be "pack varName value -intle\|-intbe\|-floatle\|-floatbe\|-str bitwidth ?bitoffset?"}
	7
	8	test pack-1.2 {pack invalid type} -body {
	9	pack a 1 -badopt 8
	10	} -returnCodes error -result {bad option "-badopt": must be -floatbe, -floatle, -intbe, -intle, or -str}
	11
	12	test pack-1.3 {pack bad width} -body {
	13	pack a 1 -intbe badint
	14	} -returnCodes error -match glob -result {expected integer *but got "badint"}
	15
	16	test pack-1.4 {pack bad width} -body {
	17	pack a 1 -intbe -5
	18	} -returnCodes error -result {bad bitwidth: -5}
	19
	20	test pack-1.5 {pack bad offset} -body {
	21	pack a 1 -intbe 5 badint
	22	} -returnCodes error -match glob -result {expected integer *but got "badint"}
	23
	24	test pack-1.6 {pack bad offset} -body {
	25	pack a 1 -intbe 5 -6
	26	} -returnCodes error -result {bad bitoffset: -6}
	27
	28	test pack-2.1 {pack basic} {
	29	unset -nocomplain a
	30	pack a 65 -intle 8
	31	set a
	32	} {A}
	33
	34	test pack-2.2 {pack append} {
	35	pack a 66 -intle 8 8
	36	set a
	37	} {AB}
	38
	39	test pack-2.3 {pack after end pads with null} {
	40	pack a 67 -intle 8 24
	41	set a
	42	} "AB\x00C"
	43
	44	test pack-2.4 {pack replace} {
	45	pack a 68 -intle 8 16
	46	set a
	47	} "ABDC"
	48
	49	test pack-2.5 {pack str after end pads with null} {
	50	pack a ghi -str 24 40
	51	set a
	52	} "ABDC\x00ghi"
	53
	54	test pack-2.6 {pack str width > string length} {
	55	set a {}
	56	pack a ab -str 32
	57	set a
	58	} "ab\x00\x00"
	59
	60	set badvar {a}
	61
	62	test pack-2.7 {pack bad set} -body {
	63	pack badvar(a) 32 -intle 8
	64	} -returnCodes error -result {can't set "badvar(a)": variable isn't array}
	65
	66	test pack-2.8 {pack bad set} -body {
	67	pack bad\x00var 32 -intle 8
	68	} -returnCodes ok -result {8}
	69
	70	test unpack-1.1 {unpack usage} -body {
	71	unpack
	72	} -returnCodes error -result {wrong # args: should be "unpack binvalue -intbe\|-intle\|-uintbe\|-uintle\|-floatbe\|-floatle\|-str bitpos bitwidth"}
	73
	74	test unpack-1.2 {unpack invalid type} -body {
	75	unpack abc -badopt 0 8
	76	} -returnCodes error -result {bad option "-badopt": must be -floatbe, -floatle, -intbe, -intle, -str, -uintbe, or -uintle}
	77
	78	test unpack-1.3 {unpack bad width} -body {
	79	unpack abc -intle 0 badint
	80	} -returnCodes error -match glob -result {expected integer *but got "badint"}
	81
	82	test unpack-1.4 {unpack bad width} -body {
	83	unpack abc -intle 0 -5
	84	} -returnCodes error -result {bad bitwidth: -5}
	85
	86	test unpack-1.5 {unpack bad offset} -body {
	87	unpack abc -intle badint 8
	88	} -returnCodes error -match glob -result {expected integer *but got "badint"}
	89
	90	test unpack-1.6 {unpack bad offset} -body {
	91	unpack abc -intle -6 8
	92	} -returnCodes error -result {bad bitoffset: -6}
	93
	94	test unpack-1.7 {unpack str not on byte boundary offset} -body {
	95	unpack abc -str 5 8
	96	} -returnCodes error -result {bad bitoffset: 5}
	97
	98	test unpack-1.8 {unpack float bad width} -body {
	99	unpack abc -floatbe 0 24
	100	} -returnCodes error -result {bad bitwidth: 24}
	101
	102	test unpack-2.1 {unpack str width past end} -body {
	103	unpack abc -str 16 16
	104	} -result c
	105
	106	test unpack-2.2 {unpack intle} -body {
	107	format 0x%04x [unpack \x01\x02\x03 -intle 8 16]
	108	} -result 0x0302
	109
	110	test unpack-2.3 {unpack int width past end} -body {
	111	unpack \x01\x02\x03 -intle 16 16
	112	} -result 3
	113
	114
	115	testreport

+24

-0

tests/package.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3	needs cmd package
	4
	5	if {[exists -proc package]} {
	6	skiptest " (bootstrap jimsh)"
	7	}
	8
	9	test package-1.1 {provide} -body {
	10	package provide new-package-name
	11	expr {"new-package-name" in [package names]}
	12	} -result 1
	13
	14	test package-1.2 {provide, duplicate} -body {
	15	package provide new-package-name
	16	} -returnCodes error -result {package "new-package-name" was already provided}
	17
	18	test package-1.3 {package names} -body {
	19	expr {"stdlib" in [package names]}
	20	} -result 1
	21
	22	testreport
	23

+37

-0

tests/parse.test less more

333	333	incr x
334	334	} 2
335	335
	336	test parse-1.66 {backslash newline} {
	337	proc "abc def" {x} { incr x; return $x }
	338	set x ["abc\
	339	def" 4]
	340	} {5}
	341
	342	test parse-1.67 {missing quote in command} -body {
	343	set x ["abc\
	344	def]
	345	} -returnCodes error -match regexp -result {missing ("\|quote)}
	346
	347	test parse-1.68 {missing quote} -body {
	348	set x "abc\
	349	line without quote
	350
	351	} -returnCodes error -match regexp -result {missing ("\|quote)}
	352
	353	test parse-1.69 {comment with trailing backslash} {
	354	set x "#abc \\"
	355	eval $x
	356	} {}
	357
	358	test parse-1.70 {info complete, missing quotes} {
	359	set v 1
	360	set result {}
	361	# missing leading quote is ok
	362	foreach p {
	363	{"abc}
	364	{"abc$v}
	365	{abc"}
	366	{abc$v"}
	367	{"abc$v"}
	368	} {
	369	lappend result [info complete $p]
	370	}
	371	set result
	372	} {0 0 1 1 1}
336	373
337	374	testreport

+37

-0

tests/posix.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3	testCmdConstraints os.getids os.gethostname os.uptime os.fork
	4
	5	test posix-1.1 {os.getids usage} -constraints os.getids -body {
	6	os.getids blah
	7	} -returnCodes error -result {wrong # args: should be "os.getids"}
	8
	9	test posix-1.2 {os.getids} -constraints os.getids -body {
	10	set uid [exec id -u]
	11	set d [os.getids]
	12	if {$d(uid) != $uid} {
	13	error "os.getids uid=$d(uid) not match system $uid"
	14	}
	15	} -result {}
	16
	17
	18	test posix-1.4 {os.uptime} -constraints os.uptime -body {
	19	string is integer -strict [os.uptime]
	20	} -result {1}
	21
	22	test posix-1.5 {os.gethostname usage} -constraints os.gethostname -body {
	23	os.gethostname blah
	24	} -returnCodes error -result {wrong # args: should be "os.gethostname"}
	25
	26	test posix-1.6 {os.gethostname} -constraints os.gethostname -body {
	27	if {[exec hostname] ne [os.gethostname]} {
	28	error "os.gethostname did not match system hostname"
	29	}
	30	} -result {}
	31
	32	test posix-1.7 {os.fork usage} -constraints os.fork -body {
	33	os.fork extra args
	34	} -returnCodes error -result {wrong # args: should be "os.fork"}
	35
	36	testreport

-0

tests/proc-new.test less more

123	123	catch {a B}
124	124	} 1
125	125
	126	test proc-3.5 "error message with optional args" {
	127	proc a {b args} {
	128	return $args
	129	}
	130	catch a msg
	131	set msg
	132	} {wrong # args: should be "a b ?arg ...?"}
	133
	134
126	135	testreport

-1

tests/proc.test less more

245	245	list [catch {proc tproc b c d e} msg]
246	246	} {1}
247	247
248
	248	test proc-5.4 {proc double args} -body {
	249	proc a {args args} {}
	250	} -returnCodes error -result {'args' specified more than once}
249	251
250	252	test proc-old-5.6 {error conditions} {
251	253	list [catch {proc tproc {{} y} {return foo}} msg] $msg

+24

-0

tests/ref.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3	needs cmd ref
	4	needs cmd collect
	5
	6	test collect-1.1 {ensure globally scoped references are deleted} {
	7	collect
	8	set result {}
	9
	10	# Create a globally scoped reference as a function name
	11	set a ::[ref testfunction -]
	12	proc $a {} { return 3 }
	13	lappend result [$a]
	14	# It shouldn't be collected
	15	lappend result [collect]
	16	lappend result [$a]
	17	unset a
	18	# Now it should be collected
	19	lappend result [collect]
	20	set result
	21	} {3 0 3 1}
	22
	23	testreport

+11

-1

tests/regcount.test less more

43	43	a{1,2}? baaaad a
44	44	a{3,4}? baaaad aaa
45	45	a{5,6}? baaaad {}
	46	(a\|b){3,4}?def baaaad {}
46	47	{\d{1,3}} 239 239
47		(aa\|bb)?c xabbaac {aac aa}
	48	(aa\|bb)?cdef xcdabbaacdef {aacdef aa}
48	49	(a\|y)+ bac {a a}
49	50	(a\|y){1,} bac {a a}
50	51	(a\|y)* bac {{} {}}

83	84	(a\|y){5,6}? baaaad {}
84	85	{[[:alpha:]]+} _bcd56_ef bcd
85	86	{[[:alnum:]]+} _bcd56_ef bcd56
	87	{[[:blank:]]+} "_b \t\n6cAF" "{ \t}"
	88	{[[:upper:]]+} "_b \t\n6cAF" {AF}
	89	{[[:lower:]]+} "_b \t\n6cAF" {b}
	90	{[[:cntrl:]]+} _bcd\x04z56_ef "\x04"
	91	{[[:print:]]+} "\v _b \t\n6cAF" {{ _b }}
	92	{[[:graph:]]+} " _,b \t\n6cAF" {_,b}
	93	{[[:punct:]]+} bcd56_,ef _,
86	94	{[\w]+} :_bcd56_ef _bcd56_ef
87	95	{[[:space:]]+} "_bc \t\r\n\f\v_" "{ \t\r\n\f\v}"
88	96	{[\x41-\x43]+} "_ABCD_" ABC

95	103	####((a)b)*b aaaaaaaaaaaaaaaaaaaaaaaaab {b {} {}}
96	104	####(a) aab {aa {}}
97	105	{^([^:=]*)(:)?(=)?$} version {version version {} {}}
	106	{\Aab.} abc,abd abc
	107	{de.\Z} def,deh,dei dei
98	108	} {
99	109	if {[string match #* $pat]} {
100	110	continue

+92

-7

tests/regexp.test less more

220	220	} {1 {can't set "f1(f2)": variable isn't array}}
221	221	test regexp-6.9 {regexp errors, -start bad int check} {
222	222	list [catch {regexp -start bogus {^$} {}} msg] $msg
223		} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
	223	} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}}
224	224	test regexp-6.10 {regexp errors, -start too few args} {
225	225	list [catch {regexp -all -start} msg] $msg
226	226	} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}

377	377	} {1 {can't set "f1(f2)": variable isn't array}}
378	378	test regexp-11.8 {regsub errors, -start bad int check} {
379	379	list [catch {regsub -start bogus pattern string rep var} msg] $msg
380		} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
	380	} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}}
381	381	test regexp-11.9 {regsub without final variable name returns value} {
382	382	regsub b abaca X
383	383	} {aXaca}

488	488	catch {unset x}
489	489	list [regsub -all -start 3 {z} hello {/&} x] $x
490	490	} {0 hello}
491		#test regexp-16.4 {regsub -start, \A behavior} {
492		# set out {}
493		# lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
494		# lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
495		#} {5 /a/b/c/d/e 3 ab/c/d/e}
	491	test regexp-16.4 {regsub -start, \A behavior} {
	492	set out {}
	493	lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
	494	lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
	495	} {5 /a/b/c/d/e 3 ab/c/d/e}
496	496	test regexp-16.5 {regsub -start, double option} {
497	497	list [regsub -start 2 -start 0 a abc c x] $x
498	498	} {1 cbc}

660	660	set value
661	661	} "\\abc\\def"
662	662
	663	test regexp-22.1 {char range} {
	664	regexp -all -inline {[a-c]+} "defaaghbcadfbaacccd"
	665	} {aa bca baaccc}
	666
	667	# Tcl doesn't like this
	668	test regexp-22.2 {reversed char range} jim {
	669	regexp -all -inline {[c-a]+} "defaaghbcadfbaacccd"
	670	} {aa bca baaccc}
	671
	672	# Note that here the hex escapes are interpreted by regexp, not by Tcl
	673	test regexp-22.3 {hex digits} {
	674	regexp -all -inline {[\x6a-\x6c]+} "jlaksdjflkwueorilkj"
	675	} {jl k j lk lkj}
	676
	677	test regexp-22.4 {uppercase hex digits} {
	678	regexp -all -inline {[\x6A-\x6C]+} "jlaksdjflkwueorilkj"
	679	} {jl k j lk lkj}
	680
	681	# Below \x9X will be treated as \x9 followed by X
	682	test regexp-22.5 {invalid hex digits} {
	683	regexp -all -inline {[\x9X\x6C]+} "jla\tX6djflyw\tueorilkj"
	684	} [list l \tX l \t l]
	685
	686	test regexp-22.6 {unicode hex digits} jim {
	687	regexp -all -inline {[\u{41}-\u{00043}]+} "AVBASDFBABDFBAFBAFA"
	688	} {A BA BAB BA BA A}
	689
	690	# \u{X41} is treated as u { X 41 }
	691	test regexp-22.7 {unicode hex digits with invalid exscape} jim {
	692	regexp -all -inline {[\u{X41}]+} "uVBAX{SD4B1}DFBAFBAFA"
	693	} {u X\{ 4 1\}}
	694
	695	test regexp-22.8 {unicode hex digits} {
	696	regexp -all -inline {[\u0041-\u0043]+} "AVBASDFBABDFBAFBAFA"
	697	} {A BA BAB BA BA A}
	698
	699	test regexp-22.9 {\U unicode hex digits} {
	700	regexp -all -inline {[\U00000041-\U00000043]+} "AVBASDFBABDFBAFBAFA"
	701	} {A BA BAB BA BA A}
	702
	703	test regexp-22.10 {Various char escapes} {
	704	set result {}
	705	foreach match [regexp -all -inline {[\e\f\v\t\b]+} "A\f\vBB\b\tC\x1BG"] {
	706	set chars {}
	707	foreach c [split $match ""] {
	708	scan $c %c char
	709	lappend chars $char
	710	}
	711	lappend result [join $chars ,]
	712	}
	713	join $result \|
	714	} {12,11\|8,9\|27}
	715
	716	test regexp-22.11 {backslash as last char} -body {
	717	regexp -all -inline "\[a\\" "ba\\d\[ef"
	718	} -returnCodes error -result {couldn't compile regular expression pattern: invalid escape \ sequence}
	719
	720	test regexp-22.12 {missing closing bracket} -body {
	721	regexp -all -inline {[abc} "abcdefghi"
	722	} -returnCodes error -result {couldn't compile regular expression pattern: brackets [] not balanced}
	723
	724	test regexp-22.13 {empty alternative} {
	725	regexp -all -inline {a(a\|b\|)c} "aacbacbaa"
	726	} {aac a ac {}}
	727
	728	test regexp-22.14 {] in set} {
	729	regexp -all -inline {[]ab]+} "aac\[ba\]cbaa"
	730	} {aa ba\] baa}
	731
	732	test regexp-22.15 {- in set} {
	733	regexp -all -inline {[-ab]+} "aac\[ba\]cb-aa"
	734	} {aa ba b-aa}
	735
	736	test regexp-22.16 {\s in set} {
	737	regexp -all -inline {[\sa]+} "aac\[b a\]c\tb-aa"
	738	} [list aa " a" \t aa]
	739
	740	test regexp-22.17 {\d in set} {
	741	regexp -all -inline {[a\d]+} "a0ac\[b a\]44c\tb-1aa7"
	742	} {a0a a 44 1aa7}
	743
663	744	# Tests resulting from bugs reported by users
664	745	test reg-31.1 {[[:xdigit:]] behaves correctly when followed by [[:space:]]} {
665	746	set str {2:::DebugWin32}

668	749	# Code used to produce {1 2:::DebugWin32 2 :::DebugWin32} !!!
669	750	} {1 2 2 {}}
670	751
	752	test reg-31.2 {scanner not reset in failed optional group} {
	753	regexp -inline {^(?:(-)(?:(\w[\w-])\\|)?)?(\w[\w-])$} -debug
	754	} {-debug - {} debug}
	755
671	756	testreport

+24

-7

tests/regexp2.test less more

286	286	evalInProc {
287	287	list [catch {regexp -start bogus {^$} {}} msg] $msg
288	288	}
289		} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
	289	} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}}
290	290
291	291	test regexpComp-7.1 {basic regsub operation} {
292	292	evalInProc {

493	493	# list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo
494	494	# }
495	495	#} "1 {da\nb123\nxb}"
	496	test regexpComp-10.6 {\Z only matching end of string with -line} {
	497	evalInProc {
	498	set foo xxx
	499	list [regsub -line {^a.*b\Z} "dabc\ncaxyb\naxb" 123 foo] $foo
	500	}
	501	} "1 {dabc\ncaxyb\n123}"
	502	test regexpComp-10.7 {\A only matching beginning of string with -line} {
	503	regexp -all -inline -line {\Aab.} abc\nabd
	504	} {abc}
496	505
497	506	test regexpComp-11.1 {regsub errors} {
498	507	evalInProc {

535	544	evalInProc {
536	545	list [catch {regsub -start bogus pattern string rep var} msg] $msg
537	546	}
538		} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
	547	} {1 {bad index "bogus": must be intexpr or end?[+-]intexpr?}}
539	548
540	549	# This test crashes on the Mac unless you increase the Stack Space to about 1
541	550	# Meg. This is probably bigger than most users want...

621	630	catch {unset x}
622	631	list [regsub -all -start 3 {z} hello {/&} x] $x
623	632	} {0 hello}
624		#test regexpComp-16.4 {regsub -start, \A behavior} {
625		# set out {}
626		# lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
627		# lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
628		#} {5 /a/b/c/d/e 3 ab/c/d/e}
	633	test regexpComp-16.4 {regsub -start, \A behavior} tcl {
	634	set out {}
	635	lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
	636	lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
	637	} {5 /a/b/c/d/e 3 ab/c/d/e}
629	638	test regexpComp-16.5 {regexp -start with utf8} utf8 {
630	639	regexp -inline -start 1 . \u0442\u0435\u0441\u0442
631	640	} \u0435
632	641	test regexpComp-16.6 {regexp -start with utf8} utf8 {
633	642	regsub -start 1 . \u0442\u0435\u0441\u0442 x
634	643	} \u0442x\u0441\u0442
	644
	645	test regexpComp-16.7 {regexp -start with \A} {
	646	regsub -start 1 {\Aabc} deabc -
	647	} {deabc}
	648
	649	test regexpComp-16.7 {regexp -start with \A} {
	650	regsub -start 1 {\Aabc} dabc -
	651	} {d-}
635	652
636	653	test regexpComp-17.1 {regexp -inline} {
637	654	regexp -inline b ababa

-2

tests/return.test less more

0	0	source [file dirname [info script]]/testing.tcl
	1
	2	set testpath [file dirname [info script]]
1	3
2	4	# return -code
3	5

7	9	} {2 result}
8	10
9	11	test return-1.2 {source file with break} {
10		list [catch {source break.tcl} msg] $msg
	12	list [catch {source $testpath/break.tcl} msg] $msg
11	13	} {3 {}}
12	14
13	15	test return-1.3 {source file with break} {
14		list [catch {source return-break.tcl} msg] $msg
	16	list [catch {source $testpath/return-break.tcl} msg] $msg
15	17	} {3 result}
16	18
17	19	proc a {level code msg} {

46	48	list [catch {b 2 20 text} msg] $msg
47	49	} {20 text}
48	50
	51	test return-2.7 {return -level 0 -code break} {
	52	list [catch {return -level 0 -code break text} msg] $msg
	53	} {3 text}
	54
	55
49	56	testreport

+18

-7

tests/runall.tcl less more

4	4
5	5	lappend auto_path .
6	6
	7	set testdir [file dirname [info script]]
	8
7	9	# In case interp is a module
8	10	catch {package require interp}
9	11
10	12	if {[info commands interp] eq ""} {
11		set rc 1
12		foreach script [lsort [glob *.test]] {
	13	set rc 0
	14	foreach script [lsort [glob $testdir/*.test]] {
13	15	if {[catch {
14	16	exec [info nameofexecutable] $script >@stdout 2>@stderr
15		set rc 0
16	17	} msg opts]} {
17	18	puts "Failed: $script"
	19	set rc 1
18	20	}
19	21	}
20	22	exit $rc
21	23	} else {
22	24	array set total {pass 0 fail 0 skip 0 tests 0}
23		foreach script [lsort [glob *.test]] {
	25	foreach script [lsort [glob $testdir/*.test]] {
24	26	set ::argv0 $script
25	27
26		if {$script eq "signal.test"} {
	28	if {[file tail $script] eq "signal.test"} {
27	29	# special case, can't run this in a child interpeter
28	30	catch -exit {
29	31	source $script

39	41	}
40	42
41	43	# Run the test
42		catch -exit {$i eval source $script} msg opts
	44	catch -exit [list $i eval [list source $script]] msg opts
43	45	if {[info returncode $opts(-code)] eq "error"} {
44	46	puts [format "%16s: --- error ($msg)" $script]
45	47	incr total(fail)
	48	} elseif {[info return $opts(-code)] eq "exit"} {
	49	# if the test explicitly called exit 99,
	50	# it must be from a child process via os.fork, so
	51	# silently exit
	52	if {$msg eq "99"} {
	53	exit 0
	54	}
46	55	}
47	56
48	57	# Extract the counts
49	58	foreach var {pass fail skip tests} {
50		incr total($var) [$i eval "set testinfo(num$var)"]
	59	catch {
	60	incr total($var) [$i eval "set testinfo(num$var)"]
	61	}
51	62	}
52	63	$i delete
53	64	}

-4

tests/scan.test less more

243	243	catch {unset x}
244	244	list [scan {xF} {%x} x] [info exists x]
245	245	} {0 0}
246		test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} {
	246	test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} jim {
247	247	set x {}
248	248	list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z
249	249	} {3 10 10 16}
250		test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} {
	250	test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} jim {
251	251	set x {}
252	252	list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z
253	253	} {3 10 10 16}

436	436	set a {}; set b {}; set c {}; set d {}
437	437	list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
438	438	} {4 4.6 99999.7 87.643 118.0}
439		test scan-6.6 {floating-point scanning} jim {
	439	test scan-6.6 {floating-point scanning} -body {
440	440	set a {}; set b {}; set c {}; set d {}
441	441	list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
442		} {4 1.2345 0.697 124.0 5e-05}
	442	} -match regexp -result {4 1\.2345 0\.697 124.0 5e-0?5}
443	443	test scan-6.7 {floating-point scanning} {
444	444	set a {}; set b {}; set c {}; set d {}
445	445	list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d

+110

-3

tests/signal.test less more

80	80	test signal-1.8 "try/signal" try {
81	81	signal handle ALRM
82	82	try -signal {
83		alarm 0.4
	83	alarm 0.8
84	84	foreach i [range 10] {
85		sleep 0.1
	85	sleep 0.2
86	86	}
87	87	set msg ""
88	88	} on signal {msg} {

91	91	alarm 0
92	92	}
93	93	signal default ALRM
94		list [expr {$i in {3 4 5}}] $msg
	94	list [expr {$i in {2 3 4}}] $msg
95	95	} {1 SIGALRM}
96	96
	97	test signal-1.9 {throw an ignored signal} {
	98	signal ignore SIGTERM
	99	signal throw SIGTERM
	100	signal check -clear SIGTERM
	101	} {SIGTERM}
	102
	103	test signal-1.10 {throw with no signal} try {
	104	# With no arg, signal throw means signal throw SIGINT
	105	try -signal {
	106	signal throw
	107	} on signal msg {
	108	}
	109	set msg
	110	} SIGINT
	111
	112	test signal-2.1 {bad signal} -body {
	113	signal handle NONEXISTENT
	114	} -returnCodes error -result {unknown signal NONEXISTENT}
	115
	116	test signal-2.2 {bad signal} -body {
	117	signal handle 999999
	118	} -returnCodes error -result {unknown signal 999999}
	119
	120	test signal-2.3 {signal by number} {
	121	signal handle 2
	122	signal default 2
	123	} {}
	124
	125	test signal-2.4 {signal block} {
	126	signal block SIGINT
	127	signal handle SIGINT
	128	signal default SIGINT
	129	} {}
	130
	131	test signal-2.5 {signal check invalid} -body {
	132	signal check NONEXISTENT
	133	} -returnCodes error -result {unknown signal NONEXISTENT}
	134
	135	test signal-2.6 {signal check invalid num} -body {
	136	signal check 999999
	137	} -returnCodes error -result {unknown signal 999999}
	138
	139	test signal-2.7 {signal throw invalid} -body {
	140	signal throw NONEXISTENT
	141	} -returnCodes error -result {unknown signal NONEXISTENT}
	142
	143	test signal-2.8 {signal throw invalid num} -body {
	144	signal throw 999999
	145	} -returnCodes error -result {unknown signal 999999}
	146
	147	test signal-2.9 {signal list} {
	148	expr {"SIGINT" in [signal default]}
	149	} {1}
	150
	151	test alarm-1.1 {alarm usage} -body {
	152	alarm
	153	} -returnCodes error -result {wrong # args: should be "alarm seconds"}
	154
	155	test alarm-1.2 {alarm usage} -body {
	156	alarm too many args
	157	} -returnCodes error -result {wrong # args: should be "alarm seconds"}
	158
	159	test alarm-1.3 {alarm usage} -body {
	160	alarm badnum
	161	} -returnCodes error -result {expected floating-point number but got "badnum"}
	162
	163	test alarm-1.4 {alarm seconds} {
	164	alarm 2
	165	alarm 0
	166	} {}
	167
	168	test sleep-1.1 {sleep usage} -body {
	169	sleep
	170	} -returnCodes error -result {wrong # args: should be "sleep seconds"}
	171
	172	test sleep-1.2 {sleep usage} -body {
	173	sleep too many args
	174	} -returnCodes error -result {wrong # args: should be "sleep seconds"}
	175
	176	test sleep-1.3 {sleep usage} -body {
	177	sleep badnum
	178	} -returnCodes error -result {expected floating-point number but got "badnum"}
	179
	180	test kill-1.1 {kill usage} -body {
	181	kill
	182	} -returnCodes error -result {wrong # args: should be "kill ?SIG\|-0? pid"}
	183
	184	test kill-1.2 {kill usage} -body {
	185	kill too many args
	186	} -returnCodes error -result {wrong # args: should be "kill ?SIG\|-0? pid"}
	187
	188	test kill-1.3 {kill bad signal} -body {
	189	kill NONEXISTENT [pid]
	190	} -returnCodes error -result {unknown signal NONEXISTENT}
	191
	192	test kill-1.4 {kill -0} {
	193	kill -0 [pid]
	194	} {}
	195
	196	test kill-1.5 {kill 0 pid} {
	197	kill 0 [pid]
	198	} {}
	199
	200	test kill-1.6 {kill to invalid process} -body {
	201	kill 0 9999999
	202	} -returnCodes error -result {kill: Failed to deliver signal}
	203
97	204	testreport

+396

-0

tests/socket.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3	needs cmd socket
	4	needs cmd os.fork
	5
	6	catch {[socket -ipv6 stream {[::1]:5000}]} res
	7	set ipv6 1
	8	if {[string match "*not supported" $res]} {
	9	set ipv6 0
	10	} else {
	11	# Also, if we can't bind an IPv6 socket, don't run IPv6 tests
	12	if {[catch {
	13	[socket -ipv6 stream.server {[::1]:5000}] close
	14	} msg opts]} {
	15	set ipv6 0
	16	}
	17	}
	18	testConstraint ipv6 $ipv6
	19
	20	# Given an IPv4 or IPv6 server socket, return an address
	21	# that a client can use to connect to the socket.
	22	# This handles the case where the server is listening on (say) 0.0.0.0:5000
	23	# but some systems need the client to connect on localhost:5000
	24	proc socket-connect-addr {s} {
	25	if {[regexp {(.*):([^:]+)} [$s sockname] -> host port]} {
	26	if {$host eq "0.0.0.0"} {
	27	return 127.0.0.1:$port
	28	} elseif {$host eq {[::]}} {
	29	return \[::1\]:$port
	30	}
	31	}
	32	return [$s sockname]
	33	}
	34
	35	test socket-1.1 {stream} -body {
	36	# Let the system choose a port
	37	set s [socket stream.server 127.0.0.1:0]
	38	stdout flush
	39	if {[os.fork] == 0} {
	40	# child
	41	set c [socket stream [$s sockname]]
	42	$s close
	43	$c puts hello
	44	$c close
	45	exit 99
	46	}
	47	set cs [$s accept]
	48	$cs gets buf
	49	$cs close
	50	$s close
	51	set buf
	52	} -result {hello}
	53
	54	test socket-1.2 {dgram - connected} -body {
	55	# Let the system choose a port
	56	set s [socket dgram.server 127.0.0.1:0]
	57	set c [socket dgram [$s sockname]]
	58	$s buffering none
	59	$c buffering none
	60	$c puts -nonewline hello
	61	set buf [$s recv 1000]
	62	$c close
	63	$s close
	64	set buf
	65	} -result {hello}
	66
	67	test socket-1.3 {dgram - unconnected} -body {
	68	# Let the system choose a port
	69	set s [socket dgram.server 127.0.0.1:0]
	70	set c [socket dgram]
	71	$s buffering none
	72	$c buffering none
	73	$c sendto hello [$s sockname]
	74	set buf [$s recv 1000]
	75	$c close
	76	$s close
	77	set buf
	78	} -result {hello}
	79
	80	test socket-1.4 {unix} -body {
	81	set path [file tempfile]
	82	file delete $path
	83	set s [socket unix.server $path]
	84	stdout flush
	85	if {[os.fork] == 0} {
	86	# child
	87	set c [socket unix [$s sockname]]
	88	$s close
	89	$c puts hello
	90	$c close
	91	exit 99
	92	}
	93	set cs [$s accept]
	94	$cs gets buf
	95	$cs close
	96	$s close
	97	set buf
	98	} -result {hello}
	99
	100	test socket-1.5 {unix.dgram} -body {
	101	set path [file tempfile]
	102	file delete $path
	103	set s [socket unix.dgram.server $path]
	104	set c [socket unix.dgram [$s sockname]]
	105	$s buffering none
	106	$c buffering none
	107	$c puts -nonewline hello
	108	set buf [$s recv 1000]
	109	$s close
	110	$c close
	111	set buf
	112	} -result {hello}
	113
	114	test socket-1.6 {pipe} -body {
	115	lassign [socket pipe] r w
	116	stdout flush
	117	if {[os.fork] == 0} {
	118	$r close
	119	$w puts hello
	120	$w close
	121	exit 99
	122	}
	123	$w close
	124	$r gets buf
	125	$r close
	126	set buf
	127	} -result {hello}
	128
	129	test socket-1.7 {socketpair} -body {
	130	lassign [socket pair] s1 s2
	131	stdout flush
	132	if {[os.fork] == 0} {
	133	$s1 close
	134	# Read data and send it back
	135	$s2 gets buf
	136	$s2 puts $buf
	137	$s2 close
	138	exit 99
	139	}
	140	$s2 close
	141	$s1 puts hello
	142	$s1 gets buf
	143	$s1 close
	144	set buf
	145	} -result {hello}
	146
	147	test socket-1.8 {stream - ipv6} -constraints ipv6 -body {
	148	# Let the system choose a port
	149	set s [socket -ipv6 stream.server {[::1]:0}]
	150	stdout flush
	151	if {[os.fork] == 0} {
	152	# child
	153	set c [socket -ipv6 stream [$s sockname]]
	154	$s close
	155	$c puts hello
	156	$c close
	157	exit 99
	158	}
	159	set cs [$s accept]
	160	$cs gets buf
	161	$cs close
	162	$s close
	163	set buf
	164	} -result {hello}
	165
	166	test socket-1.9 {dgram - ipv6 - unconnected} -constraints ipv6 -body {
	167	# Let the system choose a port
	168	set s [socket -ipv6 dgram.server {[::1]:0}]
	169	set c [socket -ipv6 dgram]
	170	$s buffering none
	171	$c buffering none
	172	$c sendto hello [$s sockname]
	173	set buf [$s recv 1000]
	174	$c close
	175	$s close
	176	set buf
	177	} -result {hello}
	178
	179	test socket-1.10 {stream - port only} -body {
	180	set s [socket stream.server 0]
	181	stdout flush
	182	if {[os.fork] == 0} {
	183	# child
	184	set c [socket stream [socket-connect-addr $s]]
	185	$s close
	186	$c puts hello
	187	$c close
	188	exit 99
	189	}
	190	set cs [$s accept]
	191	$cs gets buf
	192	$cs close
	193	$s close
	194	set buf
	195	} -result {hello}
	196
	197	test socket-1.11 {stream - ipv6 - port only} -constraints ipv6 -body {
	198	# Let the system choose a port
	199	set s [socket -ipv6 stream.server 0]
	200	stdout flush
	201	if {[os.fork] == 0} {
	202	# child
	203	set c [socket -ipv6 stream [socket-connect-addr $s]]
	204	$s close
	205	$c puts hello
	206	$c close
	207	exit 99
	208	}
	209	set cs [$s accept]
	210	$cs gets buf
	211	$cs close
	212	$s close
	213	set buf
	214	} -result {hello}
	215
	216	test socket-2.1 {read 1} -body {
	217	lassign [socket pipe] r w
	218	$w puts -nonewline hello
	219	$w close
	220	set chars {}
	221	while {1} {
	222	set c [$r read 1]
	223	if {$c eq ""} {
	224	break
	225	}
	226	lappend chars $c
	227	}
	228	$r close
	229	set chars
	230	} -result {h e l l o}
	231
	232	test socket-2.2 {read to EOF} -body {
	233	lassign [socket pipe] r w
	234	$w puts -nonewline hello
	235	$w close
	236	set buf [$r read]
	237	$r close
	238	set buf
	239	} -result {hello}
	240
	241	test socket-2.3 {read -nonewline} -body {
	242	lassign [socket pipe] r w
	243	$w puts hello
	244	$w close
	245	set buf [$r read -nonewline]
	246	$r close
	247	set buf
	248	} -result {hello}
	249
	250	test socket-2.4 {isatty} -body {
	251	lassign [socket pipe] r w
	252	set result [list [$r isatty] [$w isatty]]
	253	$r close
	254	$w close
	255	set result
	256	} -result {0 0}
	257
	258	test socket-2.5 {peername} -body {
	259	set s [socket stream.server 0]
	260	stdout flush
	261	if {[os.fork] == 0} {
	262	try {
	263	set c [socket stream [socket-connect-addr $s]]
	264	$s close
	265	$c puts [list [$c sockname] [$c peername]]
	266	$c close
	267	} on error msg {
	268	stderr puts $msg
	269	}
	270	exit 99
	271	}
	272	set cs [$s accept]
	273	lassign [$cs gets] c_sockname c_peername
	274	if {$c_sockname ne [$cs peername]} {
	275	error "client sockname=$c_sockname not equal to server peername=[$cs peername]"
	276	}
	277	if {$c_peername ne [$cs sockname]} {
	278	error "client peername=$c_peername not equal to server sockname=[$cs sockname]"
	279	}
	280	$cs close
	281	$s close
	282	} -result {}
	283
	284	test socket-3.1 {listen} {
	285	set s [socket stream.server 0]
	286	$s listen 10
	287	$s close
	288	} {}
	289
	290	test socket-3.2 {listen usage} -body {
	291	set s [socket stream.server 0]
	292	$s listen
	293	} -returnCodes error -match glob -result {wrong # args: should be "* listen backlog"} -cleanup {
	294	$s close
	295	}
	296
	297	test socket-3.3 {listen usage} -body {
	298	set s [socket stream.server 0]
	299	$s listen blah
	300	} -returnCodes error -match glob -result {expected integer but got "blah"} -cleanup {
	301	$s close
	302	}
	303
	304	test socket-3.4 {listen not a socket} -body {
	305	set f [open [info script]]
	306	$f listen 10
	307	} -returnCodes error -match regexp -result {^(Socket operation on non-socket\|Not a socket)$} -cleanup {
	308	$f close
	309	}
	310
	311	test socket-4.1 {invalid ipv6 address} -constraints ipv6 -body {
	312	socket -ipv6 stream "- invalid - address -"
	313	} -returnCodes error -result {Not a valid address: :::- invalid - address -}
	314
	315	test socket-4.2 {invalid ipv4 address} -body {
	316	socket stream {9.9.9.9.9:0}
	317	} -returnCodes error -result {Not a valid address: 9.9.9.9.9:0}
	318
	319	test socket-4.3 {sockname on non-socket} -body {
	320	set f [open [info script]]
	321	$f sockname
	322	} -returnCodes error -match regexp -result {^(Socket operation on non-socket\|Not a socket)$} -cleanup {
	323	$f close
	324	}
	325
	326	test socket-4.4 {peername on non-socket} -body {
	327	set f [open [info script]]
	328	$f peername
	329	} -returnCodes error -match regexp -result {^(Socket operation on non-socket\|Not a socket)$} -cleanup {
	330	$f close
	331	}
	332
	333	# For the eventloop tests, let's set up a client and a server where the client
	334	# simply echos everything back to the server
	335
	336	set s [socket stream.server 0]
	337	if {[os.fork] == 0} {
	338	# child
	339	set c [socket stream [socket-connect-addr $s]]
	340	# Note: We have to disable buffering here, otherwise
	341	# when we read data in $c readable {} we many leave buffered
	342	# data and readable won't retrigger.
	343	$c buffering none
	344	$s close
	345	$c readable {
	346	# when we read we need to also read any pending data,
	347	# otherwise readable won't retrigger
	348	set buf [$c read 1]
	349	if {[string length $buf] == 0} {
	350	incr readdone
	351	$c close
	352	} else {
	353	$c puts -nonewline $buf
	354	}
	355	}
	356	vwait readdone
	357	exit 99
	358	}
	359
	360	# Now set up the server
	361	set cs [$s accept addr]
	362	defer {
	363	$cs close
	364	}
	365	$s close
	366
	367	# At this point, $cs is the server connection to the client in the child process
	368
	369	test eventloop-1.1 {puts/gets} {
	370	$cs puts hello
	371	$cs gets
	372	} hello
	373
	374	test eventloop-1.2 {puts/gets} {
	375	$cs puts -nonewline again
	376	lmap p [range 5] {
	377	set c [$cs read 1]
	378	set c
	379	}
	380	} {a g a i n}
	381
	382	test sockopt-1.1 {sockopt} -body {
	383	lsort [dict keys [$cs sockopt]]
	384	} -match glob -result {tcp_nodelay}
	385
	386	test sockopt-1.2 {sockopt set} {
	387	$cs sockopt tcp_nodelay 1
	388	dict get [$cs sockopt] tcp_nodelay
	389	} 1
	390
	391	test sockopt-1.3 {sockopt set invalid} -body {
	392	$cs sockopt tcp_nodelay badbool
	393	} -returnCodes error -result {expected boolean but got "badbool"}
	394
	395	testreport

+89

-0

tests/ssl.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs constraint jim
	3	needs cmd socket
	4	needs cmd os.fork
	5	needs cmd load_ssl_certs
	6
	7	# Note that we don't actually need to load certificates with load_ssl_certs
	8	# since the openssl installation should generally automatically load
	9	# root certs
	10
	11	# Let's set up a client and a server where the client
	12	# simply echos everything back to the server
	13
	14	set s [socket stream.server 127.0.0.1:1443]
	15	if {[os.fork] == 0} {
	16	# child
	17	set c [[socket stream 127.0.0.1:1443] ssl]
	18	$s close
	19	sleep 0.25
	20	$c readable {
	21	# when we read we need to also read any pending data,
	22	# otherwise readable won't retrigger
	23	set buf [$c read -pending]
	24	if {[string length $buf] == 0} {
	25	incr ssldone
	26	$c close
	27	} else {
	28	$c puts -nonewline $buf
	29	}
	30	}
	31	vwait ssldone
	32	exit 99
	33	}
	34
	35	# Now set up the server
	36	set certpath [file dirname [info script]]
	37	set cs [[$s accept addr] ssl -server $certpath/certificate.pem $certpath/key.pem]
	38	$s close
	39	defer {
	40	$cs close
	41	}
	42
	43	# At this point, $cs is the server connection to the client in the child process
	44
	45	test ssl-1.1 {puts/gets} {
	46	$cs puts hello
	47	$cs gets
	48	} hello
	49
	50	test ssl-1.2 {puts/gets} {
	51	$cs puts -nonewline again
	52	lmap p [range 5] {
	53	set c [$cs read 1]
	54	set c
	55	}
	56	} {a g a i n}
	57
	58	test ssl-2.1 {https to google.com, gets} -body {
	59	set c [[socket stream www.google.com:443] ssl]
	60	$c puts -nonewline "GET / HTTP/1.0\r\n\r\n"
	61	$c flush
	62	set lines {}
	63	while {[$c gets buf] >= 0} {
	64	lappend lines $buf
	65	}
	66	$c close
	67	join $lines \n
	68	} -match glob -result {HTTP/1.0 200 OK*</html>}
	69
	70	test ssl-2.2 {https to google.com, read with cert verify} -body {
	71	# Note that in order to verify the cert, we need sni
	72	set c [[socket stream www.google.com:443] ssl -sni www.google.com]
	73	# Verify the cert (note that this does not check CN)
	74	$c verify
	75	$c puts -nonewline "GET / HTTP/1.0\r\n\r\n"
	76	$c flush
	77	set buf [$c read]
	78	} -match glob -result {HTTP/1.0 200 OK*</html>}
	79
	80	test ssl-2.3 {ssl to google.com on port 80} -body {
	81	# Try to talk SSL to a non-SSL server
	82	set c [[socket stream www.google.com:80] ssl]
	83	$c puts -nonewline "GET / HTTP/1.0\r\n\r\n"
	84	$c flush
	85	set buf [$c read]
	86	} -returnCodes error -match glob -result {error:*}
	87
	88	testreport

+63

-55

tests/stacktrace.test less more

0	0	source [file dirname [info script]]/testing.tcl
1		needs constraint jim; needs cmd package
	1
	2	needs constraint jim
	3	needs cmd package
	4
2	5	package require errors
	6
3	7	# Make this a proc so that the line numbers don't have to change
4	8	proc main {} {
5	9	set id1 0

12	16	if {[info exists ::expected(err-$id1.$id2)]} {
13	17	set exp $::expected(err-$id1.$id2)
14	18	}
	19	if {$type in {package badpackage} && $::tcl_platform(bootstrap)} {
	20	# bootstrap jimsh gives different results, so skip these tests
	21	continue
	22	}
15	23	test err-$id1.$id2 "Stacktrace on error type $type, method $method" {
16	24	set rc [catch {error_caller $type $method} msg]
17	25	#puts "\n-----------------\n$type, $method\n[errorInfo $msg]\n\n"
18		if {$::SHOW_EXPECTED} { puts stderr "\terr-$id1.$id2 {[list $rc $msg [info stacktrace]]}" }
	26	if {$::SHOW_EXPECTED} { puts stderr "\terr-$id1.$id2 {[list $rc $msg [basename-stacktrace [info stacktrace]]]}" }
19	27
20		list $rc $msg [info stacktrace]
	28	list $rc $msg [basename-stacktrace [info stacktrace]]
21	29	} $exp
22	30	}
23	31	}

28	36	test err-10.1 "Stacktrace on error from unknown (badcmd, call)" {
29	37	set rc [catch {error_caller badcmd call} msg]
30	38	#puts stderr "err-10.1\n[errorInfo $msg]\n"
31		#puts stderr "\terr-10.1 {[list $rc $msg [info stacktrace]]}"
	39	#puts stderr "\terr-10.1 {[list $rc $msg [basename-stacktrace [info stacktrace]]]}"
32	40
33		list $rc $msg [info stacktrace]
34		} {1 {from unknown} {{} stacktrace.test 26 {} errors.tcl 6 error_generator errors.tcl 44 error_caller stacktrace.test 30}}
	41	list $rc $msg [basename-stacktrace [info stacktrace]]
	42	} {1 {from unknown} {{} stacktrace.test 34 {} errors.tcl 6 error_generator errors.tcl 44 error_caller stacktrace.test 38}}
35	43
36	44	rename unknown ""
37	45

50	58	set g {four}
51	59
52	60	test source-1.1 "Basic line numbers" {
53		info source $a
54		} {stacktrace.test 39}
	61	basename-source [info source $a]
	62	} {stacktrace.test 47}
55	63
56	64	test source-1.2 "Line numbers after command with escaped newlines" {
57		info source $c
58		} {stacktrace.test 43}
	65	basename-source [info source $c]
	66	} {stacktrace.test 51}
59	67	test source-1.3 "Line numbers after string with newlines" {
60		info source $e
61		} {stacktrace.test 47}
	68	basename-source [info source $e]
	69	} {stacktrace.test 55}
62	70	test source-1.4 "Line numbers after string with escaped newlines" {
63		info source $g
64		} {stacktrace.test 51}
	71	basename-source [info source $g]
	72	} {stacktrace.test 59}
65	73	}
66	74
67	75	set expected {
68		err-1.1 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
69		err-1.2 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
70		err-1.3 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
71		err-1.4 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
72		err-2.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
73		err-2.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
74		err-2.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
75		err-2.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
76		err-3.1 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
77		err-3.2 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
78		err-3.3 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
79		err-3.4 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
80		err-4.1 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
81		err-4.2 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
82		err-4.3 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
83		err-4.4 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
84		err-5.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
85		err-5.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
86		err-5.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
87		err-5.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
88		err-6.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
89		err-6.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
90		err-6.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
91		err-6.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
	76	err-1.1 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
	77	err-1.2 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
	78	err-1.3 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
	79	err-1.4 {1 {invalid command name "bogus"} {{} errors.tcl 6 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
	80	err-2.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
	81	err-2.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
	82	err-2.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
	83	err-2.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 9 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
	84	err-3.1 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
	85	err-3.2 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
	86	err-3.3 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
	87	err-3.4 {1 {unmatched "["} {{} errors.tcl 62 error_badproc errors.tcl 33 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
	88	err-4.1 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
	89	err-4.2 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
	90	err-4.3 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
	91	err-4.4 {1 bogus {{} errors.tcl 12 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
	92	err-5.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
	93	err-5.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
	94	err-5.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
	95	err-5.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 15 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
	96	err-6.1 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
	97	err-6.2 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
	98	err-6.3 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
	99	err-6.4 {1 {can't read "bogus": no such variable} {{} errors.tcl 18 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
92	100	err-7.1 {1 {from dummyproc
93		Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
	101	Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
94	102	err-7.2 {1 {from dummyproc
95		Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
	103	Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
96	104	err-7.3 {1 {from dummyproc
97		Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
	105	Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
98	106	err-7.4 {1 {from dummyproc
99		Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
100		err-8.1 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
101		err-8.2 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
102		err-8.3 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
103		err-8.4 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
104		err-9.1 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 44 error_caller stacktrace.test 17}}
105		err-9.2 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 47 error_caller stacktrace.test 17}}
106		err-9.3 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 50 error_caller stacktrace.test 17}}
107		err-9.4 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 53 error_caller stacktrace.test 17}}
108		err-10.1 {1 failure {{} errors.tcl 44 error_caller stacktrace.test 17}}
109		err-10.2 {1 failure {{} errors.tcl 47 error_caller stacktrace.test 17}}
110		err-10.3 {1 failure {{} errors.tcl 50 error_caller stacktrace.test 17}}
111		err-10.4 {1 failure {{} errors.tcl 53 error_caller stacktrace.test 17}}
	107	Can't load package dummy} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 21 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
	108	err-8.1 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
	109	err-8.2 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
	110	err-8.3 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
	111	err-8.4 {1 {from dummyproc} {{} dummy.tcl 3 dummyproc dummy.tcl 6 {} errors.tcl 24 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
	112	err-9.1 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 44 error_caller stacktrace.test 25}}
	113	err-9.2 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 47 error_caller stacktrace.test 25}}
	114	err-9.3 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 50 error_caller stacktrace.test 25}}
	115	err-9.4 {1 {Can't load package bogus} {{} errors.tcl 27 error_generator errors.tcl 53 error_caller stacktrace.test 25}}
	116	err-10.1 {1 failure {{} errors.tcl 44 error_caller stacktrace.test 25}}
	117	err-10.2 {1 failure {{} errors.tcl 47 error_caller stacktrace.test 25}}
	118	err-10.3 {1 failure {{} errors.tcl 50 error_caller stacktrace.test 25}}
	119	err-10.4 {1 failure {{} errors.tcl 53 error_caller stacktrace.test 25}}
112	120	}
113	121
114	122	# Set this to output expected results to stderr
115		# in a form which can be pasted into 'expected' below
	123	# in a form which can be pasted into 'expected' above
116	124	set SHOW_EXPECTED 0
117	125
118	126	main

+77

-2

tests/string.test less more

115	115	test string-2.29 {string equal with length, unequal strings} {
116	116	string compare -length 2 ab abde
117	117	} 0
	118	test string-2.30 {string compare - bytes vs chars} {
	119	string compare abcd\u1000\u1100\u1200x abcd\u1000\u1100\u1200y
	120	} -1
	121	test string-2.31 {string compare - embedded nulls} {
	122	string compare ab\0ghi0 ab\0ghi1
	123	} -1
	124	test string-2.31 {string compare - embedded nulls, nocase} {
	125	string compare -nocase ab\0ghi0 AB\0GHi1
	126	} -1
118	127	# only need a few tests on equal, since it uses the same code as
119	128	# string compare, but just modifies the return output
120	129	test string-3.1 {string equal} {

439	448	test string-7.6 {string last} {
440	449	string las x xxxx123xx345x678
441	450	} 12
	451	test string-7.7 {string last, bad index} {
	452	string last ba badbad -1
	453	} -1
442	454	test string-7.13 {string last, start index} {
443	455	## Constrain to last 'a' should work
444	456	string last ba badbad end-1

520	532	test string-10.17 {string map, one pair case} {
521	533	string map {Ab 4321} aAbCaBaAbAbcAb
522	534	} {a4321CaBa43214321c4321}
	535	test string-10.18 {string map, nulls in string} {
	536	string map {a bc} ade\0ghia\0jkl
	537	} "bcde\0ghibc\0jkl"
	538	test string-10.19 {string map, nulls in map source} {
	539	string map {\0 bc} ade\0ghia\0jkl
	540	} "adebcghiabcjkl"
	541	test string-10.20 {string map, nulls in map dest} {
	542	string map {a A\0A} adeghiajkl
	543	} "A\0AdeghiA\0Ajkl"
	544	test string-10.21 {string map, null bytes} {
	545	string map "\u0000afternull #" foo\u0000afternull\u0000123456789bar
	546	} foo#\u0000123456789bar
523	547
524	548	test string-11.1 {string match, too few args} {
525	549	list [catch {string match a} msg]

674	698	string match "\\" "\\"
675	699	} 0
676	700
	701	test string-11.51 {string match, nulls in pattern} {
	702	string match "abc\0def" "abc\0def"
	703	} 1
	704
	705	test string-11.52 {string match, nulls in pattern} {
	706	string match "abc*\0def" "abcghi\0def"
	707	} 1
	708
	709	test string-11.53 {string match, nulls in pattern} {
	710	string match "abc\[ghi\0]def" "abc\0def"
	711	} 1
677	712
678	713	test string-12.1 {string range} {
679	714	list [catch {string range} msg]

801	836	} {}
802	837	test string-14.13 {string replace} {
803	838	list [catch {string replace abc abc 1} msg] $msg
804		} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
	839	} {1 {bad index "abc": must be intexpr or end?[+-]intexpr?}}
805	840	test string-14.14 {string replace} {
806	841	list [catch {string replace abc 1 eof} msg] $msg
807		} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
	842	} {1 {bad index "eof": must be intexpr or end?[+-]intexpr?}}
808	843	test string-14.15 {string replace} {
809	844	string replace abcdefghijklmnop end-10 end-2 NEW
810	845	} {abcdeNEWop}

955	990	string cat $abc (def)
956	991	} {123(def)}
957	992
	993	test string-24.1 {string byterange} {
	994	list [catch {string byterange} msg]
	995	} {1}
	996	test string-24.2 {string byterange} {
	997	list [catch {string byterange a 1} msg]
	998	} {1}
	999	test string-24.3 {string byterange} {
	1000	list [catch {string byterange a 1 2 3} msg]
	1001	} {1}
	1002	test string-24.4 {string byterange} {
	1003	string byterange abcdefghijklmnop 2 14
	1004	} {cdefghijklmno}
	1005	test string-24.5 {string byterange, last > length} {
	1006	string byterange abcdefghijklmnop 7 1000
	1007	} {hijklmnop}
	1008	test string-24.6 {string byterange} {
	1009	string byterange abcdefghijklmnop 10 end
	1010	} {klmnop}
	1011	test string-24.7 {string byterange, last < first} {
	1012	string byterange abcdefghijklmnop 10 9
	1013	} {}
	1014	test string-24.8 {string byterange, first < 0} {
	1015	string byterange abcdefghijklmnop -3 2
	1016	} {abc}
	1017	test string-24.9 {string byterange} {
	1018	string byterange abcdefghijklmnop -3 -2
	1019	} {}
	1020	test string-24.10 {string byterange, utf8} {
	1021	string byterange \u00b5\u00b6 0 1
	1022	} \u00b5
	1023	test string-24.11 {string byterange, slice utf8 } {
	1024	string byterange \u00b5\u00b6 1 2
	1025	} \xb5\xc2
	1026	test string-24.12 {string byterange, full range} {
	1027	string byterange abcdef 0 end
	1028	} abcdef
	1029	test string-24.13 {string byterange, invalid range} -body {
	1030	string byterange abcdef foo bar
	1031	} -returnCodes error -result {bad index "foo": must be intexpr or end?[+-]intexpr?}
	1032
958	1033	testreport

+10

-2

tests/stringmatch.test less more

213	213	string match {a[\]]c} {a]c}
214	214	} 0
215	215
216		test stringmatch=7.1 {short string with ?} {
	216	test stringmatch-7.1 {short string with ?} {
217	217	string match {ab?} ab
218	218	} 0
219	219
220		test stringmatch=7.1 {multiple * to end} {
	220	test stringmatch-7.2 {multiple * to end} {
221	221	string match {ab**} ab
222	222	} 1
223	223
	224	test stringmatch-7.3 {null in string} {
	225	string match bar foo\0bar
	226	} 1
	227
	228	test stringmatch-7.4 {null in pattern} {
	229	string match b\[\0a\]r foobar
	230	} 1
	231
224	232	testreport

-1

tests/tailcall.test less more

86	86	incr n -1
87	87	tailcall a $n
88	88	}
89		a 1000
	89	a 100000
90	90	} 1
91	91
92	92	test tailcall-1.10 {tailcall through uplevel} {

-10

tests/testing.tcl less more

0	0	# Find and load the Jim tcltest wrapper
1		if {[catch {info version}]} {
2		# Tcl
3		source [file dirname [info script]]/../tcltest.tcl
4		} else {
5		# Jim
6		if {[exists env(TOPSRCDIR)]} {
7		set auto_path [list $env(TOPSRCDIR) {*}$auto_path]
8		}
	1	source [file dirname [info script]]/../tcltest.tcl
9	2
10		package require tcltest
11		}
	3	# If jimsh is not installed we may also need to include top_srcdir for Tcl modules (.. from this script)
	4	set auto_path [list [file dirname [info script]]/.. {*}$auto_path]

+17

-17

tests/timer.test less more

22	22	after cancel $i
23	23	}
24	24	set x ""
25		foreach i {20 40 200 10 30} {
	25	foreach i {40 80 400 20 60} {
26	26	after $i lappend x $i
27	27	}
28		after 50
29		update
30		set x
31		} {10 20 30 40}
	28	after 100
	29	update
	30	set x
	31	} {20 40 60 80}
32	32
33	33	test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
34	34	foreach i [after info] {

61	61	foreach i [after info] {
62	62	after cancel $i
63	63	}
64		foreach i {40 120 200} {
	64	foreach i {80 240 400} {
65	65	after $i lappend x $i
66	66	}
67		after 50
	67	after 100
68	68	set result ""
69	69	set x ""
70	70	update
71	71	lappend result $x
72		after 80
73		update
74		lappend result $x
75		after 80
76		update
77		lappend result $x
78		} {40 {40 120} {40 120 200}}
	72	after 160
	73	update
	74	lappend result $x
	75	after 160
	76	update
	77	lappend result $x
	78	} {80 {80 240} {80 240 400}}
79	79	test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
80	80	foreach i [after info] {
81	81	after cancel $i

180	180	} {1 {bad argument "gorp": must be cancel, idle, or info}}
181	181	test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
182	182	set x before
183		after 80 {set x after}
184		after 40
	183	after 500 {set x after}
	184	after 100
185	185	update
186	186	set y $x
187		after 80
	187	after 500
188	188	update
189	189	list $y $x
190	190	} {before after}

+56

-0

tests/tty.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	set havetty 0
	3	catch {
	4	set havetty [expr {"tty" in [stdout -commands]}]
	5	}
	6	if {!$havetty \|\| ![stdout isatty]} {
	7	skiptest " (aio tty)"
	8	}
	9
	10	test tty-1.1 {tty status} {
	11	set dict [stdout tty]
	12	dict exists $dict output
	13	} 1
	14
	15	test tty-1.2 {tty bad param} -body {
	16	stdout tty bad value
	17	} -returnCodes error -result {bad setting "bad": must be baud, data, echo, handshake, input, output, parity, stop, vmin, or vtime}
	18
	19	test tty-1.3 {tty bad baud} -body {
	20	stdout tty baud 12345
	21	} -returnCodes error -result {bad value for baud: 12345}
	22
	23	test tty-1.4 {tty bad fd} -body {
	24	set f [open [file tempfile] w]
	25	$f tty
	26	} -returnCodes error -match regexp -result {^(Inappropriate ioctl for device\|Not a tty)$} -cleanup {
	27	$f close
	28	}
	29
	30
	31	set n 0
	32	foreach {param value} {
	33	output raw
	34	input raw
	35	handshake rtscts
	36	} {
	37	test tty-1.[incr n] "tty setting $param" -setup {
	38	set savetty [stdout tty]
	39	} -body "stdout tty $param $value; dict get \[stdout tty\] $param" \
	40	-result $value -cleanup {
	41	stdout tty $savetty
	42	}
	43	}
	44
	45	set n 0
	46	foreach param {output input handshake baud stop data vmin vtime} {
	47	test tty-2.[incr n] "tty bad setting $param" -setup {
	48	set savetty [stdout tty]
	49	} -body "stdout tty $param bad" \
	50	-returnCodes error -result "bad value for $param: bad" -cleanup {
	51	stdout tty $savetty
	52	}
	53	}
	54
	55	testreport

+27

-0

tests/utf8.test less more

148	148	string length \u12000
149	149	} 2
150	150
	151	test utf8-8.5 {\U} jim {
	152	set x \U000000b5
	153	} \ub5
	154
	155	test utf8-8.6 {\u invalid} {
	156	set x "\u{0000000b5}"
	157	} "u{0000000b5}"
	158
	159	test utf8-9.1 {string totitle} {
	160	string totitle \u01c4-test
	161	} "\u01c5-test"
	162
	163	test utf8-9.2 {string totitle} {
	164	string totitle \u01c5-test
	165	} "\u01c5-test"
	166
	167	test utf8-9.3 {string totitle} {
	168	string totitle abc-\u01c4
	169	} "Abc-\u01c6"
	170
	171	# Previously scan was using char length instead of byte length
	172	# when iterating over the string
	173	test utf8-10.1 {scan with utf-8} {
	174	scan ab\u0300c %c%c%c%c a b c d
	175	list $a $b $c $d
	176	} {97 98 768 99}
	177
151	178	testreport

+62

-0

tests/xtrace.test less more

	0	source [file dirname [info script]]/testing.tcl
	1
	2	needs cmd xtrace
	3
	4	# Simply accumulate the callback args in the list ::lines
	5	proc xtracetest {args} {
	6	lappend ::lines $args
	7	}
	8
	9	proc xtracesummary {lines} {
	10	# Omit the last line that will always be xtrace {}
	11	# Remove file and line
	12	lmap line [lrange $lines 0 end-1] {
	13	lassign $line type file line result cmd arglist
	14	list $type ($result) $cmd $arglist
	15	}
	16	}
	17
	18	proc xtracetestproc {a} {
	19	append a " world"
	20	return $a
	21	}
	22
	23	test xtrace-1.1 {xtrace usage} -body {
	24	xtrace
	25	} -returnCodes error -result {wrong # args: should be "xtrace callback"}
	26
	27	test xtrace-1.2 {xtrace non-proc} -body {
	28	set lines {}
	29	xtrace xtracetest
	30	set x 3
	31	xtrace {}
	32	xtracesummary $lines
	33	} -result {{cmd () set {x 3}}}
	34
	35	# This will produce 4 calls to the trace callback
	36	# 1. xtracetestproc hello (cmd)
	37	# 2. xtracetestproc hello (proc - when executing the proc body)
	38	# 3. append a " hello"
	39	# 4. return "hello world" (previous command result will be "hello world")
	40	test xtrace-1.3 {xtrace proc} -body {
	41	set lines {}
	42	xtrace xtracetest
	43	xtracetestproc hello
	44	xtrace {}
	45	xtracesummary $lines
	46	} -result {{cmd () xtracetestproc hello} {proc () xtracetestproc hello} {cmd () append {a { world}}} {cmd {(hello world)} return {{hello world}}}}
	47
	48	test xtrace-1.4 {xtrace line numbers} -body {
	49	set lines {}
	50	xtrace xtracetest
	51	set x abc
	52	xtrace {}
	53	# Now the first callback should happen at the correct line number
	54	lassign [lindex $lines 0] - tracefile traceline
	55	lassign [info source $x] file line
	56	if {"$tracefile:$traceline" eq "$file:$line"} {
	57	function ok
	58	}
	59	} -result {ok}
	60
	61	testreport