aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--autoconf/tea/Makefile.in79
-rw-r--r--autoconf/tea/_teaish.tester.tcl.in3
-rw-r--r--autoconf/tea/teaish.tcl3
-rw-r--r--autosetup/proj.tcl475
-rw-r--r--autosetup/teaish/core.tcl135
-rw-r--r--autosetup/teaish/tester.tcl71
-rw-r--r--manifest22
-rw-r--r--manifest.uuid2
8 files changed, 585 insertions, 205 deletions
diff --git a/autoconf/tea/Makefile.in b/autoconf/tea/Makefile.in
index 5b2ad4c69..ccf9a7b94 100644
--- a/autoconf/tea/Makefile.in
+++ b/autoconf/tea/Makefile.in
@@ -146,7 +146,7 @@ LDFLAGS.shlib = @SH_LDFLAGS@
# sources passed to [teaish-src-add], but may also be appended to by
# teaish.make.
#
-tx.src =@TEAISH_EXT_SRC@
+tx.src = @TEAISH_EXT_SRC@
#
# tx.CFLAGS is typically set by teaish.make, whereas TEAISH_CFLAGS
@@ -167,6 +167,11 @@ tx.LDFLAGS =
#
tx.dist.files = @TEAISH_DIST_FILES@
+#
+# The base name for a distribution tar/zip file.
+#
+tx.dist.basename = $(tx.name.dist)-$(tx.version)
+
# List of deps which may trigger an auto-reconfigure.
#
teaish__autogen.deps = \
@@ -199,9 +204,14 @@ $(teaish.makefile): $(teaish__auto.def) $(teaish.makefile.in) \
@AUTODEPS@
@if TEAISH_TESTER_TCL_IN
-@TEAISH_TESTER_TCL_IN@:
-@TEAISH_TESTER_TCL@: @TEAISH_TESTER_TCL_IN@
-config.log: @TEAISH_TESTER_TCL@
+@TEAISH_TESTER_TCL_IN@: $(teaish__autogen.deps)
+config.log: @TEAISH_TESTER_TCL_IN@
+@TEAISH_TESTER_TCL@: @TEAISH_TESTER_TCL_IN@
+@endif
+@if TEAISH_TEST_TCL_IN
+@TEAISH_TEST_TCL_IN@: $(teaish__autogen.deps)
+config.log: @TEAISH_TEST_TCL_IN@
+@TEAISH_TEST_TCL@: @TEAISH_TEST_TCL_IN@
@endif
#
@@ -217,7 +227,7 @@ CC.tcl = \
#
CC.dll = \
$(CC.tcl) $(tx.src) $(LDFLAGS.shlib) \
- $(LDFLAGS.configure) $(LDFLAGS) $(tx.LDFLAGS) $(TCL_STUB_LIB_SPEC)
+ $(tx.LDFLAGS) $(LDFLAGS.configure) $(LDFLAGS) $(TCL_STUB_LIB_SPEC)
@if TEAISH_ENABLE_DLL
#
@@ -248,16 +258,25 @@ test-extension: # this name is reserved for use by teaish.make[.in]
test-prepre: $(tx.dll)
@endif
@if TEAISH_TESTER_TCL
-test-core.args = @TEAISH_TESTER_TCL@
+teaish.tester.tcl = @TEAISH_TESTER_TCL@
+test-core.args = $(teaish.tester.tcl)
@if TEAISH_ENABLE_DLL
test-core.args += '$(tx.dll)' '$(tx.loadPrefix)'
@else
test-core.args += '' ''
@endif
test-core.args += @TEAISH_TESTUTIL_TCL@
+# Clients may pass additional args via test.args=...
+# and ::argv will be rewritten before the test script loads, to
+# remove $(test-core.args)
+test.args ?=
test-core: test-pre
- $(TCLSH) $(test-core.args)
-test-prepre: @TEAISH_TESTER_TCL@
+ $(TCLSH) $(test-core.args) $(test.args)
+test-gdb: $(teaish.tester.tcl)
+ gdb --args $(TCLSH) $(test-core.args) $(test.args)
+test-vg.flags ?= --leak-check=full -v --show-reachable=yes --track-origins=yes
+test-vg: $(teaish.tester.tcl)
+ valgrind $(test-vg.flags) $(TCLSH) $(test-core.args) $(test.args)
@else # !TEAISH_TESTER_TCL
test-prepre:
@endif # TEAISH_TESTER_TCL
@@ -288,7 +307,7 @@ distclean-core: distclean-pre
@endif
@endif
@if TEAISH_TESTER_TCL_IN
- rm -f @TEAISH_TESTER_TCL@
+ rm -f $(teaish.tester.tcl)
@endif
@if TEAISH_PKGINDEX_TCL_IN
rm -f @TEAISH_PKGINDEX_TCL@
@@ -355,10 +374,15 @@ install-core: install-pre
@endif
install-test: install-core
@echo "Post-install test of [package require $(tx.name.pkg) $(tx.version)]..."; \
+ set xtra=""; \
+ if [ x != "x$(DESTDIR)" ]; then \
+ xtra='set ::auto_path [linsert $$::auto_path 0 [file normalize $(DESTDIR)$(TCLLIBDIR)/..]];'; \
+ fi; \
if echo \
- 'set c 0; ' \
+ 'set c 0; ' $$xtra \
'@TEAISH_POSTINST_PREREQUIRE@' \
- 'if {[catch {package require $(tx.name.pkg) $(tx.version)}]} {incr c};' \
+ 'if {[catch {package require $(tx.name.pkg) $(tx.version)} xc]} {incr c};' \
+ 'if {$$c && "" ne $$xc} {puts $$xc; puts "auto_path=$$::auto_path"};' \
'exit $$c' \
| $(TCLSH) ; then \
echo "passed"; \
@@ -406,7 +430,7 @@ config.log: $(teaish.makefile.in)
# recognized when running in --teaish-install mode, causing
# the sub-configure to fail.
dist.flags = --with-tclsh=$(TCLSH)
-dist.reconfig = $(teaish.dir)/configure $(dist.flags)
+dist.reconfig = $(teaish.dir)/configure $(tx.dist.reconfig-flags) $(dist.flags)
# Temp dir for dist.zip. Must be different than dist.tgz or else
# parallel builds may hose the dist.
@@ -414,24 +438,23 @@ teaish__dist.tmp.zip = teaish__dist_zip
#
# Make a distribution zip file...
#
-dist.basename = $(tx.name.dist)-$(tx.version)
-dist.zip = $(dist.basename).zip
+dist.zip = $(tx.dist.basename).zip
.PHONY: dist.zip dist.zip-core dist.zip-post
#dist.zip-pre:
# We apparently can't add a pre-hook here, else "make dist" rebuilds
# the archive each time it's run.
$(dist.zip): $(tx.dist.files)
@rm -fr $(teaish__dist.tmp.zip)
- @mkdir -p $(teaish__dist.tmp.zip)/$(dist.basename)
+ @mkdir -p $(teaish__dist.tmp.zip)/$(tx.dist.basename)
@tar cf $(teaish__dist.tmp.zip)/tmp.tar $(tx.dist.files)
- @tar xf $(teaish__dist.tmp.zip)/tmp.tar -C $(teaish__dist.tmp.zip)/$(dist.basename)
+ @tar xf $(teaish__dist.tmp.zip)/tmp.tar -C $(teaish__dist.tmp.zip)/$(tx.dist.basename)
@if TEAISH_DIST_FULL
@$(dist.reconfig) \
- --teaish-install=$(teaish__dist.tmp.zip)/$(dist.basename) \
- --t-e-d=$(teaish__dist.tmp.zip)/$(dist.basename) >/dev/null
+ --teaish-install=$(teaish__dist.tmp.zip)/$(tx.dist.basename) \
+ --t-e-d=$(teaish__dist.tmp.zip)/$(tx.dist.basename) >/dev/null
@endif
- @rm -f $(dist.basename)/tmp.tar $(dist.zip)
- @cd $(teaish__dist.tmp.zip) && zip -q -r ../$(dist.zip) $(dist.basename)
+ @rm -f $(tx.dist.basename)/tmp.tar $(dist.zip)
+ @cd $(teaish__dist.tmp.zip) && zip -q -r ../$(dist.zip) $(tx.dist.basename)
@rm -fr $(teaish__dist.tmp.zip)
@ls -la $(dist.zip)
dist.zip-core: $(dist.zip)
@@ -447,23 +470,23 @@ undist: undist-zip
# Make a distribution tarball...
#
teaish__dist.tmp.tgz = teaish__dist_tgz
-dist.tgz = $(dist.basename).tar.gz
+dist.tgz = $(tx.dist.basename).tar.gz
.PHONY: dist.tgz dist.tgz-core dist.tgz-post
# dist.tgz-pre:
# see notes in dist.zip
$(dist.tgz): $(tx.dist.files)
@rm -fr $(teaish__dist.tmp.tgz)
- @mkdir -p $(teaish__dist.tmp.tgz)/$(dist.basename)
+ @mkdir -p $(teaish__dist.tmp.tgz)/$(tx.dist.basename)
@tar cf $(teaish__dist.tmp.tgz)/tmp.tar $(tx.dist.files)
- @tar xf $(teaish__dist.tmp.tgz)/tmp.tar -C $(teaish__dist.tmp.tgz)/$(dist.basename)
+ @tar xf $(teaish__dist.tmp.tgz)/tmp.tar -C $(teaish__dist.tmp.tgz)/$(tx.dist.basename)
@if TEAISH_DIST_FULL
- @rm -f $(teaish__dist.tmp.tgz)/$(dist.basename)/pkgIndex.tcl.in; # kludge
+ @rm -f $(teaish__dist.tmp.tgz)/$(tx.dist.basename)/pkgIndex.tcl.in; # kludge
@$(dist.reconfig) \
- --teaish-install=$(teaish__dist.tmp.tgz)/$(dist.basename) \
- --t-e-d=$(teaish__dist.tmp.zip)/$(dist.basename) >/dev/null
+ --teaish-install=$(teaish__dist.tmp.tgz)/$(tx.dist.basename) \
+ --t-e-d=$(teaish__dist.tmp.zip)/$(tx.dist.basename) >/dev/null
@endif
- @rm -f $(dist.basename)/tmp.tar $(dist.tgz)
- @cd $(teaish__dist.tmp.tgz) && tar czf ../$(dist.tgz) $(dist.basename)
+ @rm -f $(tx.dist.basename)/tmp.tar $(dist.tgz)
+ @cd $(teaish__dist.tmp.tgz) && tar czf ../$(dist.tgz) $(tx.dist.basename)
@rm -fr $(teaish__dist.tmp.tgz)
@ls -la $(dist.tgz)
dist.tgz-core: $(dist.tgz)
diff --git a/autoconf/tea/_teaish.tester.tcl.in b/autoconf/tea/_teaish.tester.tcl.in
index 59d11f0a8..e04d8e63e 100644
--- a/autoconf/tea/_teaish.tester.tcl.in
+++ b/autoconf/tea/_teaish.tester.tcl.in
@@ -21,7 +21,8 @@ if {[llength [lindex $::argv 0]] > 0} {
# ----^^^^^^^ needed on Haiku when argv 0 is just a filename, else
# load cannot find the file.
}
-source -encoding utf-8 [lindex $::argv 2]; # teaish/tester.tcl
+set ::argv [lassign $argv - -]
+source -encoding utf-8 [lindex $::argv 0]; # teaish/tester.tcl
@if TEAISH_PKGINIT_TCL
apply {{file} {
set dir [file dirname $::argv0]
diff --git a/autoconf/tea/teaish.tcl b/autoconf/tea/teaish.tcl
index 9333495aa..c52d58f07 100644
--- a/autoconf/tea/teaish.tcl
+++ b/autoconf/tea/teaish.tcl
@@ -67,6 +67,7 @@ apply {{dir} {
-vsatisfies 8.6-
-libDir sqlite$version
-pragmas $pragmas
+ -src generic/tclsqlite3.c
}
}} [teaish-get -dir]
@@ -119,8 +120,6 @@ proc teaish-options {} {
proc teaish-configure {} {
use teaish/feature
- teaish-src-add -dist -dir generic/tclsqlite3.c
-
if {[proj-opt-was-provided override-sqlite-version]} {
teaish-pkginfo-set -version [opt-val override-sqlite-version]
proj-warn "overriding sqlite version number:" [teaish-pkginfo-get -version]
diff --git a/autosetup/proj.tcl b/autosetup/proj.tcl
index 133556706..1a90b479a 100644
--- a/autosetup/proj.tcl
+++ b/autosetup/proj.tcl
@@ -60,10 +60,11 @@
# $proj__Config is an internal-use-only array for storing whatever generic
# internal stuff we need stored.
#
-array set ::proj__Config {
- self-tests 1
-}
-
+array set ::proj__Config [subst {
+ self-tests [get-env proj.self-tests 0]
+ verbose-assert [get-env proj.assert-verbose 0]
+ isatty [isatty? stdout]
+}]
#
# List of dot-in files to filter in the final stages of
@@ -75,7 +76,6 @@ array set ::proj__Config {
# See: proj-dot-ins-append and proj-dot-ins-process
#
set ::proj__Config(dot-in-files) [list]
-set ::proj__Config(isatty) [isatty? stdout]
#
# @proj-warn msg
@@ -85,28 +85,29 @@ set ::proj__Config(isatty) [isatty? stdout]
#
proc proj-warn {args} {
show-notices
- puts stderr [join [list "WARNING: \[[proj-scope 1]\]: " {*}$args] " "]
+ puts stderr [join [list "WARNING:" \[ [proj-scope 1] \]: {*}$args] " "]
}
+#
# Internal impl of [proj-fatal] and [proj-error]. It must be called
# using tailcall.
-proc proj__faterr {failMode argv} {
+#
+proc proj__faterr {failMode args} {
show-notices
set lvl 1
- while {"-up" eq [lindex $argv 0]} {
- set argv [lassign $argv -]
+ while {"-up" eq [lindex $args 0]} {
+ set args [lassign $args -]
incr lvl
}
if {$failMode} {
- puts stderr [join [list "FATAL: \[[proj-scope $lvl]]: " {*}$argv]]
+ puts stderr [join [list "FATAL:" \[ [proj-scope $lvl] \]: {*}$args]]
exit 1
} else {
- error [join [list "\[[proj-scope $lvl]]:" {*}$argv]]
+ error [join [list in \[ [proj-scope $lvl] \]: {*}$args]]
}
}
-
#
# @proj-fatal ?-up...? msg...
#
@@ -118,7 +119,7 @@ proc proj__faterr {failMode argv} {
# additional level.
#
proc proj-fatal {args} {
- tailcall proj__faterr 1 $args
+ tailcall proj__faterr 1 {*}$args
}
#
@@ -127,10 +128,9 @@ proc proj-fatal {args} {
# Works like proj-fatal but uses [error] intead of [exit].
#
proc proj-error {args} {
- tailcall proj__faterr 0 $args
+ tailcall proj__faterr 0 {*}$args
}
-set ::proj__Config(verbose-assert) [get-env proj-assert-verbose 0]
#
# @proj-assert script ?message?
#
@@ -147,7 +147,7 @@ proc proj-assert {script {msg ""}} {
if {"" eq $msg} {
set msg $script
}
- proj-fatal "Assertion failed in \[[proj-scope 1]\]: $msg"
+ tailcall proj__faterr 1 "Assertion failed:" $msg
}
}
@@ -1665,7 +1665,7 @@ proc proj-dot-ins-append {fileIn args} {
proj-fatal "Too many arguments: $fileIn $args"
}
}
- #puts "******* [proj-scope]: adding $fileIn"
+ #puts "******* [proj-scope]: adding [llength $fileIn]-length item: $fileIn"
lappend ::proj__Config(dot-in-files) $fileIn
}
@@ -1703,17 +1703,18 @@ proc proj-dot-ins-list {} {
# makes proj-dot-ins-append available for re-use.
#
proc proj-dot-ins-process {args} {
- proj-parse-simple-flags args flags {
+ proj-parse-flags args flags {
-touch "" {return "-touch"}
-clear 0 {expr 1}
-validate 0 {expr 1}
}
+ #puts "args=$args"; parray flags
if {[llength $args] > 0} {
error "Invalid argument to [proj-scope]: $args"
}
foreach f $::proj__Config(dot-in-files) {
proj-assert {3==[llength $f]} \
- "Expecting proj-dot-ins-list to be stored in 3-entry lists"
+ "Expecting proj-dot-ins-list to be stored in 3-entry lists. Got: $f"
lassign $f fIn fOut fScript
#puts "DOING $fIn ==> $fOut"
proj-make-from-dot-in {*}$flags(-touch) $fIn $fOut
@@ -1753,7 +1754,7 @@ proc proj-validate-no-unresolved-ats {args} {
set isMake [string match {*[Mm]ake*} $f]
foreach line [proj-file-content-list $f] {
if {!$isMake || ![string match "#*" [string trimleft $line]]} {
- if {[regexp {(@[A-Za-z0-9_]+@)} $line match]} {
+ if {[regexp {(@[A-Za-z0-9_\.]+@)} $line match]} {
error "Unresolved reference to $match at line $lnno of $f"
}
}
@@ -1893,7 +1894,7 @@ proc proj-define-amend {args} {
#
proc proj-define-to-cflag {args} {
set rv {}
- proj-parse-simple-flags args flags {
+ proj-parse-flags args flags {
-list 0 {expr 1}
-quote 0 {expr 1}
-zero-undef 0 {expr 1}
@@ -2001,7 +2002,7 @@ proc proj-cache-key {arg {addLevel 0}} {
# See proj-cache-key for -key's and -level's semantics, noting that
# this function adds one to -level for purposes of that call.
proc proj-cache-set {args} {
- proj-parse-simple-flags args flags {
+ proj-parse-flags args flags {
-key => 0
-level => 0
}
@@ -2037,7 +2038,7 @@ proc proj-cache-remove {{key 0} {addLevel 0}} {
# See proj-cache-key for $key's and $addLevel's semantics, noting that
# this function adds one to $addLevel for purposes of that call.
proc proj-cache-check {args} {
- proj-parse-simple-flags args flags {
+ proj-parse-flags args flags {
-key => 0
-level => 0
}
@@ -2070,147 +2071,321 @@ proc proj-coalesce {args} {
}
#
-# @proj-parse-simple-flags ...
+# @proj-parse-flags argvListName targetArrayName {prototype}
#
# A helper to parse flags from proc argument lists.
#
-# Expects a list of arguments to parse, an array name to store any
-# -flag values to, and a prototype object which declares the flags.
+# The first argument is the name of a var holding the args to
+# parse. It will be overwritten, possibly with a smaller list.
#
-# The prototype must be a list in one of the following forms:
+# The second argument is the name of an array variable to create in
+# the caller's scope.
#
-# -flag defaultValue {script}
+# The third argument, $prototype, is a description of how to handle
+# the flags. Each entry in that list must be in one of the
+# following forms:
#
-# -flag => defaultValue
-# -----^--^ (with spaces there!)
+# -flag defaultValue ?-literal|-call|-apply?
+# script|number|incr|proc-name|{apply $aLambda}
#
-# Repeated for each flag.
+# -flag* ...as above...
#
-# The first form represents a basic flag with no associated
-# following argument. The second form extracts its value
-# from the following argument in $argvName.
+# -flag => defaultValue ?-call proc-name-and-args|-apply lambdaExpr?
#
-# The first argument to this function is the name of a var holding the
-# args to parse. It will be overwritten, possibly with a smaller list.
+# -flag* => ...as above...
#
-# The second argument the name of an array variable to create in the
-# caller's scope. (Pneumonic: => points to the next argument.)
+# :PRAGMA
#
-# For the first form of flag, $script is run in the caller's scope if
-# $argv contains -flag, and the result of that script is the new value
-# for $tgtArrayName(-flag). This function intercepts [return $val]
-# from $script. Any empty script will result in the flag having ""
-# assigned to it.
+# The first two forms represents a basic flag with no associated
+# following argument. The third and fourth forms, called arg-consuming
+# flags, extract the value from the following argument in $argvName
+# (pneumonic: => points to the next argument.). The :PRAGMA form
+# offers a way to configure certain aspects of this call.
#
-# The args list is only inspected until the first argument which is
-# not described by $prototype. i.e. the first "non-flag" (not counting
-# values consumed for flags defined like --flag=>default).
+# If $argv contains any given flag from $prototype, its default value
+# is overridden depending on several factors:
#
-# If a "--" flag is encountered, no more arguments are inspected as
-# flags. If "--" is the first non-flag argument, the "--" flag is
-# removed from the results but all remaining arguments are passed
-# through. If "--" appears after the first non-flag, it is retained.
+# - If the -literal flag is used, or the flag's script is a number,
+# value is used verbatim.
+#
+# - Else if the -call flag is used, the argument must be a proc name
+# and any leading arguments, e.g. {apply $myLambda}. The proc is passed
+# the (flag, value) as arguments (non-consuming flags will get
+# passed the flag's current/starting value and consuming flags will
+# get the next argument). Its result becomes the result of the
+# flag.
+#
+# - Else if -apply X is used, it's effectively shorthand for -call
+# {apply X}. Its argument may either be a $lambaRef or a {{f v}
+# {body}} construct.
#
-# This function assumes that each flag is unique, and using a flag
-# more than once behaves in a last-one-wins fashion.
+# - Else if $script is one of the following values, it is treated as
+# the result of...
+#
+# - incr: increments the current value of the flag.
+#
+# - Else $script is eval'd to get its result value. That result
+# becomes the new flag value for $tgtArrayName(-flag). This
+# function intercepts [return $val] from eval'ing $script. Any
+# empty script will result in the flag having "" assigned to it.
+#
+# Unless the -flag has a trailing asterisk, e.g. -flag*, this function
+# assumes that each flag is unique, and using a flag more than once
+# causes an error to be triggered. the -flag* forms works similarly
+# except that may appear in $argv any number of times:
+#
+# - For non-arg-consuming flags, each invocation of -flag causes the
+# result of $script to overwrite the previous value. e.g. so
+# {-flag* {x} {incr foo}} has a default value of x, but passing in
+# -flag twice would change it to the result of incrementing foo
+# twice. This form can be used to implement, e.g., increasing
+# verbosity levels by passing -verbose multiple times.
+#
+# - For arg-consuming flags, the given flag starts with value X, but
+# if the flag is provided in $argv, the default is cleared, then
+# each instance of -flag causes its value to be appended to the
+# result, so {-flag* => {a b c}} defaults to {a b c}, but passing
+# in -flag y -flag z would change it to {y z}, not {a b c y z}..
+#
+# By default, the args list is only inspected until the first argument
+# which is not described by $prototype. i.e. the first "non-flag" (not
+# counting values consumed for flags defined like -flag => default).
+# The :all-flags pragma (see below) can modify this behavior.
+#
+# If a "--" flag is encountered, no more arguments are inspected as
+# flags unless the :all-flags pragma (see below) is in effect. The
+# first instance of "--" is removed from the target result list but
+# all remaining instances of "--" are are passed through.
#
-# Any argvName entries not described in $prototype are not treated as
-# flags.
+# Any argvName entries not described in $prototype are considered to
+# be "non-flags" for purposes of this function, even if they
+# ostensibly look like flags.
#
-# Returns the number of flags it processed in $argvName.
+# Returns the number of flags it processed in $argvName, not counting
+# "--".
#
# Example:
#
-# set args [list -foo -bar {blah} 8 9 10 -theEnd]
-# proj-parse-simple-flags args flags {
-# -foo 0 {expr 1}
-# -bar => 0
-# -no-baz 2 {return 0}
-# }
+## set args [list -foo -bar {blah} -z 8 9 10 -theEnd]
+## proj-parse-flags args flags {
+## -foo 0 {expr 1}
+## -bar => 0
+## -no-baz 1 {return 0}
+## -z 0 2
+## }
#
-# After that $flags would contain {-foo 1 -bar {blah} -no-baz 2}
+# After that $flags would contain {-foo 1 -bar {blah} -no-baz 1 -z 2}
# and $args would be {8 9 10 -theEnd}.
#
-# Potential TODOs: consider using lappend instead of set so that any
-# given flag can be used more than once. Or add a syntax to indicate
-# that multiples are allowed. Also consider searching the whole
-# argv list, rather than stopping at the first non-flag
+# Pragmas:
#
-proc proj-parse-simple-flags {argvName tgtArrayName prototype} {
+# Passing :PRAGMAS to this function may modify how it works. The
+# following pragmas are supported (note the leading ":"):
+#
+# :all-flags indicates that the whole input list should be scanned,
+# not stopping at the first non-flag or "--".
+#
+proc proj-parse-flags {argvName tgtArrayName prototype} {
upvar $argvName argv
- upvar $tgtArrayName tgt
- array set dflt {}
- array set scripts {}
- array set consuming {}
+ upvar $tgtArrayName outFlags
+ array set flags {}; # staging area
+ array set scripts {}; # map of -flag=>script
+ array set consuming {}; # map of -flag=>1 for arg-consuming flags
+ array set multi {}; # map of -flag=>1 for multi-time flags
+ array set seen {}; # map of -flag=>number of times seen
+ array set call {}; # map of -flag=>1 for -call entries
+ set incrSkip 1; # 1 if we stop at the first non-flag, else 0
+ # Parse $prototype for flag definitions...
set n [llength $prototype]
- # Figure out what our flags are...
+ set checkProtoFlag {
+ #puts "**** checkProtoFlag #$i of $n k=$k fv=$fv"
+ switch -exact -- $fv {
+ -literal {
+ proj-assert {![info exists consuming($k)]}
+ set scripts($k) [list expr [lindex $prototype [incr i]]]
+ }
+ -apply {
+ set fv [lindex $prototype [incr i]]
+ if {2 == [llength $fv]} {
+ # Treat this as a lambda literal
+ set fv [list $fv]
+ }
+ lappend call($k) "apply $fv"
+ }
+ -call {
+ # arg is either a proc name or {apply $aLambda}
+ set fv [lindex $prototype [incr i]]
+ lappend call($k) $fv
+ }
+ default {
+ proj-assert {![info exists consuming($k)]}
+ set scripts($k) $fv
+ }
+ }
+ if {$i >= $n} {
+ proj-error -up "[proj-scope]: Missing argument for $k flag"
+ }
+ }
for {set i 0} {$i < $n} {incr i} {
set k [lindex $prototype $i]
#puts "**** #$i of $n k=$k"
+
+ # Check for :PRAGMA...
+ switch -exact -- $k {
+ :all-flags {
+ set incrSkip 0
+ continue
+ }
+ }
+
proj-assert {[string match -* $k]} \
- "Invalid flag value: $k"
- set v ""
- set s ""
+ "Invalid argument: $k"
+
+ if {[string match {*\*} $k]} {
+ # Re-map -foo* to -foo and flag -foo as a repeatable flag
+ set k [string map {* ""} $k]
+ incr multi($k)
+ }
+
+ if {[info exists flags($k)]} {
+ proj-error -up "[proj-scope]: Duplicated prototype for flag $k"
+ }
+
switch -exact -- [lindex $prototype [expr {$i + 1}]] {
=> {
+ # -flag => DFLT ?-subflag arg?
incr i 2
if {$i >= $n} {
- proj-error "Missing argument for $k => flag"
+ proj-error -up "[proj-scope]: Missing argument for $k => flag"
+ }
+ incr consuming($k)
+ set vi [lindex $prototype $i]
+ if {$vi in {-apply -call}} {
+ proj-error -up "[proj-scope]: Missing default value for $k flag"
+ } else {
+ set fv [lindex $prototype [expr {$i + 1}]]
+ if {$fv in {-apply -call}} {
+ incr i
+ eval $checkProtoFlag
+ }
}
- set consuming($k) 1
- set v [lindex $prototype $i]
}
default {
- set v [lindex $prototype [incr i]]
- set s [lindex $prototype [incr i]]
- set scripts($k) $s
+ # -flag VALUE ?flag? SCRIPT
+ set vi [lindex $prototype [incr i]]
+ set fv [lindex $prototype [incr i]]
+ eval $checkProtoFlag
}
}
- #puts "**** #$i of $n k=$k v=$v s=$s"
- set dflt($k) $v
+ #puts "**** #$i of $n k=$k vi=$vi"
+ set flags($k) $vi
}
- # Now look for those flags in the source list
- array set tgt [array get dflt]
- unset dflt
+ #puts "-- flags"; parray flags
+ #puts "-- scripts"; parray scripts
+ #puts "-- calls"; parray call
set rc 0
set rv {}
set skipMode 0
set n [llength $argv]
+ # Now look for those flags in $argv...
for {set i 0} {$i < $n} {incr i} {
set arg [lindex $argv $i]
+ #puts "-- [proj-scope] arg=$arg"
if {$skipMode} {
lappend rv $arg
} elseif {"--" eq $arg} {
- incr skipMode
- } elseif {[info exists tgt($arg)]} {
- if {[info exists consuming($arg)]} {
- if {$i + 1 >= $n} {
- proj-assert 0 {Cannot happen - bounds already checked}
+ # "--" is the conventional way to end processing of args
+ if {[incr seen(--)] > 1} {
+ # Elide only the first one
+ lappend rv $arg
+ }
+ incr skipMode $incrSkip
+ } elseif {[info exists flags($arg)]} {
+ # A known flag...
+ set isMulti [info exists multi($arg)]
+ incr seen($arg)
+ if {1 < $seen($arg) && !$isMulti} {
+ proj-error -up [proj-scope] "$arg flag was used multiple times"
+ }
+ set vMode 0; # 0=as-is, 1=eval, 2=call
+ set isConsuming [info exists consuming($arg)]
+ if {$isConsuming} {
+ incr i
+ if {$i >= $n} {
+ proj-error -up [proj-scope] "is missing argument for $arg flag"
+ }
+ set vv [lindex $argv $i]
+ } elseif {[info exists scripts($arg)]} {
+ set vMode 1
+ set vv $scripts($arg)
+ } else {
+ set vv $flags($arg)
+ }
+
+ if {[info exists call($arg)]} {
+ set vMode 2
+ set vv [concat {*}$call($arg) $arg $vv]
+ } elseif {$isConsuming} {
+ proj-assert {!$vMode}
+ # fall through
+ } elseif {"" eq $vv || [string is double -strict $vv]} {
+ set vMode 0
+ } elseif {$vv in {incr}} {
+ set vMode 0
+ switch -exact $vv {
+ incr {
+ set xx $flags($k); incr xx; set vv $xx; unset xx
+ }
+ default {
+ proj-error "Unhandled \$vv value $vv"
+ }
}
- set tgt($arg) [lindex $argv [incr i]]
- } elseif {"" eq $scripts($arg)} {
- set tgt($arg) ""
} else {
- #puts "**** running scripts($arg) $scripts($arg)"
- set code [catch {uplevel 1 $scripts($arg)} xrc xopt]
- #puts "**** tgt($arg)=$scripts($arg) code=$code rc=$rc"
- if {$code in {0 2}} {
- set tgt($arg) $xrc
+ set vv [list eval $vv]
+ set vMode 1
+ }
+ if {$vMode} {
+ set code [catch [list uplevel 1 $vv] vv xopt]
+ if {$code ni {0 2}} {
+ return {*}$xopt $vv
+ }
+ }
+ if {$isConsuming && $isMulti} {
+ if {1 == $seen($arg)} {
+ # On the first hit, overwrite the default with a new list.
+ set flags($arg) [list $vv]
} else {
- return {*}$xopt $xrc
+ # On subsequent hits, append to the list.
+ lappend flags($arg) $vv
}
+ } else {
+ set flags($arg) $vv
}
incr rc
} else {
- incr skipMode
+ # Non-flag
+ incr skipMode $incrSkip
lappend rv $arg
}
}
set argv $rv
+ array set outFlags [array get flags]
+ #puts "-- rv=$rv argv=$argv flags="; parray flags
return $rc
+}; # proj-parse-flags
+
+#
+# Older (deprecated) name of proj-parse-flags.
+#
+proc proj-parse-simple-flags {args} {
+ tailcall proj-parse-flags {*}$args
}
if {$::proj__Config(self-tests)} {
+ set __ova $::proj__Config(verbose-assert);
+ set ::proj__Config(verbose-assert) 1
+ puts "Running [info script] self-tests..."
+ # proj-cache...
apply {{} {
#proj-warn "Test code for proj-cache"
proj-assert {![proj-cache-check -key here check]}
@@ -2233,4 +2408,100 @@ if {$::proj__Config(self-tests)} {
proj-assert {"" eq [proj-cache-remove]}
proj-assert {"" eq $check}
}}
-}
+
+ # proj-parse-flags ...
+ apply {{} {
+ set foo 3
+ set argv {-a "hi - world" -b -b -b -- -a {bye bye} -- -d -D c -a "" --}
+ proj-parse-flags argv flags {
+ :all-flags
+ -a* => "gets overwritten"
+ -b* 7 {incr foo}
+ -d 1 0
+ -D 0 1
+ }
+
+ #puts "-- argv = $argv"; parray flags;
+ proj-assert {"-- c --" eq $argv}
+ proj-assert {$flags(-a) eq "{hi - world} {bye bye} {}"}
+ proj-assert {$foo == 6}
+ proj-assert {$flags(-b) eq $foo}
+ proj-assert {$flags(-d) == 0}
+ proj-assert {$flags(-D) == 1}
+ set foo 0
+ foreach x $flags(-a) {
+ proj-assert {$x in {{hi - world} {bye bye} {}}}
+ incr foo
+ }
+ proj-assert {3 == $foo}
+
+ set argv {-a {hi world} -b -maybe -- -a {bye bye} -- -b c --}
+ set foo 0
+ proj-parse-flags argv flags {
+ -a => "aaa"
+ -b 0 {incr foo}
+ -maybe no -literal yes
+ }
+ #parray flags; puts "--- argv = $argv"
+ proj-assert {"-a {bye bye} -- -b c --" eq $argv}
+ proj-assert {$flags(-a) eq "hi world"}
+ proj-assert {1 == $flags(-b)}
+ proj-assert {"yes" eq $flags(-maybe)}
+
+ set argv {-f -g -a aaa -M -M -M -L -H -A AAA a b c}
+ set foo 0
+ set myLambda {{flag val} {
+ proj-assert {$flag in {-f -g -M}}
+ #puts "myLambda flag=$flag val=$val"
+ incr val
+ }}
+ proc myNonLambda {flag val} {
+ proj-assert {$flag in {-A -a}}
+ #puts "myNonLambda flag=$flag val=$val"
+ concat $val $val
+ }
+ proj-parse-flags argv flags {
+ -f 0 -call {apply $myLambda}
+ -g 2 -apply $myLambda
+ -h 3 -apply $myLambda
+ -H 30 33
+ -a => aAAAa -apply {{f v} {
+ set v
+ }}
+ -A => AaaaA -call myNonLambda
+ -B => 17 -call myNonLambda
+ -M* 0 -apply $myLambda
+ -L "" -literal $myLambda
+ }
+ rename myNonLambda ""
+ #puts "--- argv = $argv"; parray flags
+ proj-assert {$flags(-f) == 1}
+ proj-assert {$flags(-g) == 3}
+ proj-assert {$flags(-h) == 3}
+ proj-assert {$flags(-H) == 33}
+ proj-assert {$flags(-a) == {aaa}}
+ proj-assert {$flags(-A) eq "AAA AAA"}
+ proj-assert {$flags(-B) == 17}
+ proj-assert {$flags(-M) == 3}
+ proj-assert {$flags(-L) eq $myLambda}
+
+ set argv {-touch -validate}
+ proj-parse-flags argv flags {
+ -touch "" {return "-touch"}
+ -validate 0 1
+ }
+ #puts "----- argv = $argv"; parray flags
+ proj-assert {$flags(-touch) eq "-touch"}
+ proj-assert {$flags(-validate) == 1}
+ proj-assert {$argv eq {}}
+
+ set argv {-i -i -i}
+ proj-parse-flags argv flags {
+ -i* 0 incr
+ }
+ proj-assert {3 == $flags(-i)}
+ }}
+ set ::proj__Config(verbose-assert) $__ova
+ unset __ova
+ puts "Done running [info script] self-tests."
+}; # proj- API self-tests
diff --git a/autosetup/teaish/core.tcl b/autosetup/teaish/core.tcl
index 33c6e1898..307462ec3 100644
--- a/autosetup/teaish/core.tcl
+++ b/autosetup/teaish/core.tcl
@@ -92,6 +92,7 @@ array set teaish__Config [proj-strip-hash-comments {
-tm.tcl.in TEAISH_TM_TCL_IN
-options {}
-pragmas {}
+ -src {}
}
#
@@ -331,29 +332,33 @@ proc teaish-configure-core {} {
-url - -v ""
-tm.tcl - -v ""
-tm.tcl.in - -v ""
+ -src - -v ""
} {
+ #proj-assert 0 {Just testing}
set isPIFlag [expr {"-" ne $pflag}]
if {$isPIFlag} {
if {[info exists ::teaish__PkgInfo($pflag)]} {
# Was already set - skip it.
continue;
}
- proj-assert {{-} eq $key}
+ proj-assert {{-} eq $key};# "Unexpected pflag=$pflag key=$key type=$type val=$val"
set key $f2d($pflag)
}
- proj-assert {"" ne $key}
- set got [get-define $key "<nope>"]
- if {"<nope>" ne $got} {
- # Was already set - skip it.
- continue
+ if {"" ne $key} {
+ if {"<nope>" ne [get-define $key "<nope>"]} {
+ # Was already set - skip it.
+ continue
+ }
}
switch -exact -- $type {
-v {}
-e { set val [eval $val] }
default { proj-error "Invalid type flag: $type" }
}
- #puts "***** defining default $pflag $key {$val} isPIFlag=$isPIFlag got=$got"
- define $key $val
+ #puts "***** defining default $pflag $key {$val} isPIFlag=$isPIFlag"
+ if {$key ne ""} {
+ define $key $val
+ }
if {$isPIFlag} {
set ::teaish__PkgInfo($pflag) $val
}
@@ -541,10 +546,10 @@ proc teaish__configure_phase1 {} {
define TEAISH_VSATISFIES_CODE [join $code "\n"]
}}; # vsatisfies
- if {[proj-looks-like-windows] || [proj-looks-like-mac]} {
+ if {[proj-looks-like-windows]} {
# Without this, linking of an extension will not work on Cygwin or
# Msys2.
- msg-result "Using USE_TCL_STUBS for this environment"
+ msg-result "Using USE_TCL_STUBS for Unix(ish)-on-Windows environment"
teaish-cflags-add -DUSE_TCL_STUBS=1
}
@@ -585,7 +590,8 @@ proc teaish__configure_phase1 {} {
#
if {0x0f & $::teaish__Config(pkginit-policy)} {
file delete -force -- [get-define TEAISH_PKGINIT_TCL]
- proj-dot-ins-append [get-define TEAISH_PKGINIT_TCL_IN]
+ proj-dot-ins-append [get-define TEAISH_PKGINIT_TCL_IN] \
+ [get-define TEAISH_PKGINIT_TCL]
}
if {0x0f & $::teaish__Config(tm-policy)} {
file delete -force -- [get-define TEAISH_TM_TCL]
@@ -595,17 +601,20 @@ proc teaish__configure_phase1 {} {
apply {{} {
# Queue up any remaining dot-in files
set dotIns [list]
- foreach d {
- TEAISH_TESTER_TCL_IN
- TEAISH_TEST_TCL_IN
- TEAISH_MAKEFILE_IN
+ foreach {dIn => dOut} {
+ TEAISH_TESTER_TCL_IN => TEAISH_TESTER_TCL
+ TEAISH_TEST_TCL_IN => TEAISH_TEST_TCL
+ TEAISH_MAKEFILE_IN => TEAISH_MAKEFILE
} {
- lappend dotIns [get-define $d ""]
- }
- lappend dotIns $::autosetup(srcdir)/Makefile.in; # must be after TEAISH_MAKEFILE_IN
- foreach f $dotIns {
- if {"" ne $f} {
- proj-dot-ins-append $f
+ lappend dotIns [get-define $dIn ""] [get-define $dOut ""]
+ }
+ lappend dotIns $::autosetup(srcdir)/Makefile.in Makefile; # must be after TEAISH_MAKEFILE_IN.
+ # Much later: probably because of timestamps for deps purposes :-?
+ #puts "dotIns=$dotIns"
+ foreach {i o} $dotIns {
+ if {"" ne $i && "" ne $o} {
+ #puts " pre-dot-ins-append: \[$i\] -> \[$o\]"
+ proj-dot-ins-append $i $o
}
}
}}
@@ -640,10 +649,10 @@ proc teaish__configure_phase1 {} {
#
# NO [define]s after this point!
#
- proj-dot-ins-process -validate
proj-if-opt-truthy teaish-dump-defines {
proj-file-write config.defines.txt $tdefs
}
+ proj-dot-ins-process -validate
}; # teaish__configure_phase1
@@ -1068,7 +1077,7 @@ If you are attempting an out-of-tree build, use
]]} {
if {[string match *.in $extM]} {
define TEAISH_MAKEFILE_IN $extM
- define TEAISH_MAKEFILE [file rootname [file tail $extM]]
+ define TEAISH_MAKEFILE _[file rootname [file tail $extM]]
} else {
define TEAISH_MAKEFILE_IN ""
define TEAISH_MAKEFILE $extM
@@ -1136,8 +1145,8 @@ If you are attempting an out-of-tree build, use
set flist [list $dirExt/teaish.test.tcl.in $dirExt/teaish.test.tcl]
if {[proj-first-file-found ttt $flist]} {
if {[string match *.in $ttt]} {
- # Generate teaish.test.tcl from $ttt
- set xt [file rootname [file tail $ttt]]
+ # Generate _teaish.test.tcl from $ttt
+ set xt _[file rootname [file tail $ttt]]
file delete -force -- $xt; # ensure no stale copy is used
define TEAISH_TEST_TCL $xt
define TEAISH_TEST_TCL_IN $ttt
@@ -1304,7 +1313,6 @@ proc teaish-ldflags-prepend {args} {
# object files (which are typically in the build tree)).
#
proc teaish-src-add {args} {
- set i 0
proj-parse-simple-flags args flags {
-dist 0 {expr 1}
-dir 0 {expr 1}
@@ -1389,7 +1397,7 @@ proc teaish__cleanup_rule {{tgt clean}} {
return ${tgt}-_${x}_
}
-# @teaish-make-obj objfile srcfile ?...args?
+# @teaish-make-obj ?flags? ?...args?
#
# Uses teaish-make-add to inject makefile rules for $objfile from
# $srcfile, which is assumed to be C code which uses libtcl. Unless
@@ -1403,43 +1411,45 @@ proc teaish__cleanup_rule {{tgt clean}} {
# Any arguments after the 2nd may be flags described below or, if no
# -recipe is provided, flags for the compiler call.
#
+# -obj obj-filename.o
+#
+# -src src-filename.c
+#
# -recipe {...}
# Uses the trimmed value of {...} as the recipe, prefixing it with
# a single hard-tab character.
#
# -deps {...}
-# List of extra files to list as dependencies of $o. Good luck
-# escaping non-trivial cases properly.
+# List of extra files to list as dependencies of $o.
#
# -clean
# Generate cleanup rules as well.
-proc teaish-make-obj {o src args} {
- set consume 0
- set clean 0
- set flag ""
- array set flags {}
- set xargs {}
- foreach arg $args {
- if {$consume} {
- set consume 0
- set flags($flag) $arg
- continue
- }
- switch -exact -- $arg {
- -clean {incr clean}
- -recipe -
- -deps {
- set flag $arg
- incr consume
- }
- default {
- lappend xargs $arg
- }
+proc teaish-make-obj {args} {
+ proj-parse-simple-flags args flags {
+ -clean 0 {expr 1}
+ -recipe => {}
+ -deps => {}
+ -obj => {}
+ -src => {}
+ }
+ #parray flags
+ if {"" eq $flags(-obj)} {
+ set args [lassign $args flags(-obj)]
+ if {"" eq $flags(-obj)} {
+ proj-error "Missing -obj flag."
}
}
+ foreach f {-deps -src} {
+ set flags($f) [string trim [string map {\n " "} $flags($f)]]
+ }
+ foreach f {-deps -src} {
+ set flags($f) [string trim $flags($f)]
+ }
+ #parray flags
+ #puts "-- args=$args"
teaish-make-add \
- "# [proj-scope 1] -> [proj-scope] $o $src" -nl \
- "$o: $src $::teaish__Config(teaish.tcl)"
+ "# [proj-scope 1] -> [proj-scope] $flags(-obj) $flags(-src)" -nl \
+ "$flags(-obj): $flags(-src) $::teaish__Config(teaish.tcl)"
if {[info exists flags(-deps)]} {
teaish-make-add " " [join $flags(-deps)]
}
@@ -1447,12 +1457,12 @@ proc teaish-make-obj {o src args} {
if {[info exists flags(-recipe)]} {
teaish-make-add [string trim $flags(-recipe)] -nl
} else {
- teaish-make-add [join [list \$(CC.tcl) -c $src {*}$xargs]] -nl
+ teaish-make-add [join [list \$(CC.tcl) -c $flags(-src) {*}$args]] -nl
}
- if {$clean} {
+ if {$flags(-clean)} {
set rule [teaish__cleanup_rule]
teaish-make-add \
- "clean: $rule\n$rule:\n\trm -f \"$o\"\n"
+ "clean: $rule\n$rule:\n\trm -f \"$flags(-obj)\"\n"
}
}
@@ -2080,6 +2090,17 @@ proc teaish-pkginfo-set {args} {
set v $x
}
+ -src {
+ set d $::teaish__Config(extension-dir)
+ foreach f $v {
+ lappend ::teaish__Config(dist-files) $f
+ lappend ::teaish__Config(extension-src) $d/$f
+ lappend ::teaish__PkgInfo(-src) $f
+ # ^^^ so that default-value initialization in
+ # teaish-configure-core recognizes that it's been set.
+ }
+ }
+
-tm.tcl -
-tm.tcl.in {
if {0x30 & $::teaish__Config(pkgindex-policy)} {
@@ -2517,7 +2538,7 @@ proc teaish__install {{dDest ""}} {
] {
teaish__verbose 1 msg-result "Copying files to $destDir..."
file mkdir $destDir
- foreach f [glob -directory $srcDir *] {
+ foreach f [glob -nocomplain -directory $srcDir *] {
if {[string match {*~} $f] || [string match "#*#" [file tail $f]]} {
# Editor-generated backups and emacs lock files
continue
diff --git a/autosetup/teaish/tester.tcl b/autosetup/teaish/tester.tcl
index d8b5f7a0e..a25b366e8 100644
--- a/autosetup/teaish/tester.tcl
+++ b/autosetup/teaish/tester.tcl
@@ -99,7 +99,7 @@ proc test__affert {failMode args} {
lassign $args script msg
}
incr ::test__Counters($what)
- if {![uplevel 1 [concat expr [list $script]]]} {
+ if {![uplevel 1 expr [list $script]]} {
if {"" eq $msg} {
set msg $script
}
@@ -137,6 +137,40 @@ proc assert {args} {
}
#
+# @assert-matches ?-e? pattern ?-e? rhs ?msg?
+#
+# Equivalent to assert {[string match $pattern $rhs]} except that
+# if either of those are prefixed with an -e flag, they are eval'd
+# and their results are used.
+#
+proc assert-matches {args} {
+ set evalLhs 0
+ set evalRhs 0
+ if {"-e" eq [lindex $args 0]} {
+ incr evalLhs
+ set args [lassign $args -]
+ }
+ set args [lassign $args pattern]
+ if {"-e" eq [lindex $args 0]} {
+ incr evalRhs
+ set args [lassign $args -]
+ }
+ set args [lassign $args rhs msg]
+
+ if {$evalLhs} {
+ set pattern [uplevel 1 $pattern]
+ }
+ if {$evalRhs} {
+ set rhs [uplevel 1 $rhs]
+ }
+ #puts "***pattern=$pattern\n***rhs=$rhs"
+ tailcall test__affert 1 \
+ [join [list \[ string match [list $pattern] [list $rhs] \]]] $msg
+ # why does this not work? [list \[ string match [list $pattern] [list $rhs] \]] $msg
+ # "\[string match [list $pattern] [list $rhs]\]"
+}
+
+#
# @test-assert testId script ?msg?
#
# Works like [assert] but emits $testId to stdout first.
@@ -157,7 +191,7 @@ proc test-expect {testId script result} {
puts "test $testId"
set x [string trim [uplevel 1 $script]]
set result [string trim $result]
- tailcall test__affert 0 [list $x eq $result] \
+ tailcall test__affert 0 [list "{$x}" eq "{$result}"] \
"\nEXPECTED: <<$result>>\nGOT: <<$x>>"
}
@@ -169,7 +203,7 @@ proc test-expect {testId script result} {
#
proc test-catch {cmd args} {
if {[catch {
- $cmd {*}$args
+ uplevel 1 $cmd {*}$args
} rc xopts]} {
puts "[test-current-scope] ignoring failure of: $cmd [lindex $args 0]: $rc"
return 1
@@ -177,6 +211,37 @@ proc test-catch {cmd args} {
return 0
}
+#
+# @test-catch-matching pattern (script|cmd args...)
+#
+# Works like test-catch, but it expects its argument(s) to to throw an
+# error matching the given string (checked with [string match]). If
+# they do not throw, or the error does not match $pattern, this
+# function throws, else it returns 1.
+#
+# If there is no second argument, the $cmd is assumed to be a script,
+# and will be eval'd in the caller's scope.
+#
+# TODO: add -glob and -regex flags to control matching flavor.
+#
+proc test-catch-matching {pattern cmd args} {
+ if {[catch {
+ #puts "**** catch-matching cmd=$cmd args=$args"
+ if {0 == [llength $args]} {
+ uplevel 1 $cmd {*}$args
+ } else {
+ $cmd {*}$args
+ }
+ } rc xopts]} {
+ if {[string match $pattern $rc]} {
+ return 1
+ } else {
+ error "[test-current-scope] exception does not match {$pattern}: {$rc}"
+ }
+ }
+ error "[test-current-scope] expecting to see an error matching {$pattern}"
+}
+
if {![array exists ::teaish__BuildFlags]} {
array set ::teaish__BuildFlags {}
}
diff --git a/manifest b/manifest
index d84021d64..67810fc43 100644
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Random\stypo\sfixes\sin\sJNI\sdocs.
-D 2025-05-30T15:46:52.989
+C Configure-related\sfixes\sand\sadditions,\smost\snotably\sintegration\sof\sself-tests\sfor\sproj.tcl's\sAPIs.\sTeaish\smake-install\sfixes\sbased\son\sthe\sdiscussion\sin\s[forum:87e6660191a472c5\s|\sforum\sthread\s87e6660191a472c5].
+D 2025-05-30T16:08:31.088
F .fossil-settings/binary-glob 61195414528fb3ea9693577e1980230d78a1f8b0a54c78cf1b9b24d0a409ed6a x
F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1
F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea
@@ -22,15 +22,15 @@ F autoconf/Makefile.msc f15ad424ca2820df8e39d9157965710af0a64d87773706706a12ea4f
F autoconf/README.first f1d3876e9a7852c22f275a6f06814e64934cecbc0b5b9617d64849094c1fd136
F autoconf/README.txt b749816b8452b3af994dc6d607394bef3df1736d7e09359f1087de8439a52807
F autoconf/auto.def 3d994f3a9cc9b712dbce92a5708570ddcf3b988141b6eb738f2ed16127a9f0ac
-F autoconf/tea/Makefile.in 14c6a79ce87e10d8a35398f2d0e04e1d83a88eb52ee16ebf0eeaccf005ff84b3
+F autoconf/tea/Makefile.in bf6b43eafcd18766d81a8f0085cfc9cb051d8abae9031a8e7c3f5f1246e8f166
F autoconf/tea/README.txt 656d4686c509d375f5988ff3deda94f65fe6cd8358cd55d1f1dcc7b6e2ff73aa
-F autoconf/tea/_teaish.tester.tcl.in ed5445512e91c12afbbb99771efb68a23be4a046d52d61213fb5b6f010118129
+F autoconf/tea/_teaish.tester.tcl.in 8253b44be88e2e3f21de95a65d3a90c2be8e70b7bdd08a5b80e337ba7402f8f1
F autoconf/tea/auto.def ce95b9450e2fa4ba5dc857e208fe10f4e6f2d737796ac3278aee6079db417529
F autoconf/tea/configure d0b12b984edca6030d1976375b80157ac78b5b90a5b4f0dcee39357f63f4a80b x
F autoconf/tea/doc/sqlite3.n 9a97f4f717ceab73004ea412af7960625c1cb24b5c25e4ae4c8b5d8fa4300f4e
F autoconf/tea/license.terms 13bd403c9610fd2b76ece0ab50c4c5eda933d523
F autoconf/tea/pkgIndex.tcl.in e07da6b94561f4aa382bab65b1ccceb04701b97bf59d007c1d1f20a222b22d07
-F autoconf/tea/teaish.tcl 81571a9f9ae5c70735595b05586cb2de9d2aea7e32aad10417c4982f2e2f01c8
+F autoconf/tea/teaish.tcl a2224762a039ed30c45cc1ce4b2fde5667fb0aa2569bb56590f5cb5d45d7410b
F autoconf/tea/teaish.test.tcl cfe94e1fb79dd078f650295be59843d470125e0cc3a17a1414c1fb8d77f4aea6
F autosetup/LICENSE 41a26aebdd2cd185d1e2b210f71b7ce234496979f6b35aef2cbf6b80cbed4ce4
F autosetup/README.autosetup a78ff8c4a3d2636a4268736672a74bf14a82f42687fcf0631a70c516075c031e
@@ -47,13 +47,13 @@ F autosetup/cc.tcl c0fcc50ca91deff8741e449ddad05bcd08268bc31177e613a6343bbd1fd3e
F autosetup/find_tclconfig.tcl e64886ffe3b982d4df42cd28ed91fe0b5940c2c5785e126c1821baf61bc86a7e
F autosetup/jimsh0.c 563b966c137a4ce3c9333e5196723b7ac0919140a9d7989eb440463cd855c367
F autosetup/pkg-config.tcl 4e635bf39022ff65e0d5434339dd41503ea48fc53822c9c5bde88b02d3d952ba
-F autosetup/proj.tcl c4a77735b57f3c016a185bff048212a197b77723f9bea6cfafe396e4b542c666
+F autosetup/proj.tcl a4d7eb8d7e05328ac6202abe813da300db2fa89f1936a69f3f9d75300b4ff244
F autosetup/sqlite-config.tcl ccda82e43e377b832aae72a1678b1dc17dcaff36ed0ebbd8f0cfc88612ae8de3
F autosetup/system.tcl 51d4be76cd9a9074704b584e5c9cbba616202c8468cf9ba8a4f8294a7ab1dba9
F autosetup/teaish/README.txt b40071e6f8506500a2f7f71d5fc69e0bf87b9d7678dd9da1e5b4d0acbf40b1ca
-F autosetup/teaish/core.tcl a37bd039881bc1b0adfa25808966e62108b1e8194e730f1d1e06aad7e57b1f6e
+F autosetup/teaish/core.tcl 8824c4c37075814a1a7613ca30c0654460779b1765c091bf3600e378c8fdf3e0
F autosetup/teaish/feature.tcl 18194fb79a24d30e5bbdeab40999616f39278b53a27525349ded033af2fd73be
-F autosetup/teaish/tester.tcl 091745984473faea6985254b9986c6dfd0cce06f68bc515ba4afc1e6b3742fa8
+F autosetup/teaish/tester.tcl 1799514c2652db49561b3386c5242b94534d1663f2cfac861a955e071895fdd0
F configure 9a00b21dfd13757bbfb8d89b30660a89ec1f8f3a79402b8f9f9b6fc475c3303a x
F contrib/sqlitecon.tcl eb4c6578e08dd353263958da0dc620f8400b869a50d06e271ab0be85a51a08d3
F doc/F2FS.txt c1d4a0ae9711cfe0e1d8b019d154f1c29e0d3abfe820787ba1e9ed7691160fcd
@@ -2207,8 +2207,8 @@ F tool/version-info.c 3b36468a90faf1bbd59c65fd0eb66522d9f941eedd364fabccd7227350
F tool/warnings-clang.sh bbf6a1e685e534c92ec2bfba5b1745f34fb6f0bc2a362850723a9ee87c1b31a7
F tool/warnings.sh 1ad0169b022b280bcaaf94a7fa231591be96b514230ab5c98fbf15cd7df842dd
F tool/win/sqlite.vsix deb315d026cc8400325c5863eef847784a219a2f
-P 22441955e03df07903b98832a60c05c53721cd67c667f6c83d5e97fcc62735ee
-R 1edac9bbd25a5eccbabbe70c4bbe99ec
+P f63608a3847469b130e029cc569fe6f03a9053352ec43c10d69849cbab4f61c5
+R 45ee8fcc96567a1f284bf3c5475d67ce
U stephan
-Z 90faa1c75772444c7902de216c0e90a8
+Z 1517f3bde51bc97155127eadd67c114a
# Remove this line to create a well-formed Fossil manifest.
diff --git a/manifest.uuid b/manifest.uuid
index 4b36985f3..f3a66759e 100644
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-f63608a3847469b130e029cc569fe6f03a9053352ec43c10d69849cbab4f61c5
+2e486f8fd011d28fdd7e59ff34f7f04374019932eb160a8c4de56a5ce01e5782
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-19 17:27:55 +0000