# 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
#
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 = \
@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
#
#
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
#
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
@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@
@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"; \
# 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.
#
# 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)
# 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)
# $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
# 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
#
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...
#
# additional level.
#
proc proj-fatal {args} {
- tailcall proj__faterr 1 $args
+ tailcall proj__faterr 1 {*}$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?
#
if {"" eq $msg} {
set msg $script
}
- proj-fatal "Assertion failed in \[[proj-scope 1]\]: $msg"
+ tailcall proj__faterr 1 "Assertion failed:" $msg
}
}
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
}
# 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
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"
}
}
#
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}
# 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
}
# 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
}
}
#
-# @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]}
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
-tm.tcl.in TEAISH_TM_TCL_IN
-options {}
-pragmas {}
+ -src {}
}
#
-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
}
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
}
#
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]
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
}
}
}}
#
# 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
]]} {
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
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
# 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}
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
# 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)]
}
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"
}
}
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)} {
] {
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
projects / thirdparty / sqlite.git / commitdiff
