From: stephan Date: Tue, 15 Apr 2025 15:20:30 +0000 (+0000) Subject: Cleanups and refactoring in proj.tcl and teaish. X-Git-Tag: major-release~89 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=850289bf1e3bb5916f2acdcd00a6e7baf11940c7;p=thirdparty%2Fsqlite.git Cleanups and refactoring in proj.tcl and teaish. FossilOrigin-Name: 6b7ca8176e8c1b5e99e177c3daaba47b0674fa2f82d91754e7a8f66460ca8419 --- diff --git a/autoconf/tea/autosetup/core.tcl b/autoconf/tea/autosetup/core.tcl index ad7e942e54..c265e50a58 100644 --- a/autoconf/tea/autosetup/core.tcl +++ b/autoconf/tea/autosetup/core.tcl @@ -27,9 +27,9 @@ define TEAISH_VERSION 0.1-beta use system ; # Will output "Host System" and "Build System" lines if {"--help" ni $::argv} { proj-tweak-default-env-dirs - msg-result "Source dir = $::autosetup(srcdir)" - msg-result "Build dir = $::autosetup(builddir)" msg-result "TEA(ish) Version = [get-define TEAISH_VERSION]" + msg-result "Source dir = $::autosetup(srcdir)" + msg-result "Build dir = $::autosetup(builddir)" } # @@ -38,23 +38,25 @@ array set teaish__Config [proj-strip-hash-comments { # set to 1 to enable some internal debugging output debug-enabled 0 # - # 0 = default - # 0x01 = teaish__find-extension found input in TEAISH_DIR - # 0x02 = teaish__find-extension found input in srcdir - # 0x04 = teaish__find-extension found output file but no input - # 0x10 = teaish-pragma was called: use their pkgIndex.tcl + # 0 = don't yet have extension's pkgindex + # 0x01 = teaish__find_extension found TEAISH_DIR/pkgindex.tcl + # 0x02 = teaish__find_extension found srcdir/pkgindex.tcl.in + # 0x04 = teaish__find_extension found TEAISH_DIR/pkgindex.tcl (static file) + # 0x10 = teaish-pragma was called: behave as if 0x04 # pkgindex-policy 0 }] # -# Returns true if any arg in $::argv matches the given glob, else -# returns false. +# Returns true if any arg in $::argv matches any of the given globs, +# else returns false. # -proc teaish__argv-has {glob} { - foreach arg $::argv { - if {[string match $glob $arg]} { - return 1 +proc teaish__argv_has {args} { + foreach glob $args { + foreach arg $::argv { + if {[string match $glob $arg]} { + return 1 + } } } return 0 @@ -66,26 +68,27 @@ proc teaish__argv-has {glob} { # proc teaish-configure-core {} { # - # "Declare" some defines for potential later use. + # "Declare" some defines... # foreach {f v} { TEAISH_MAKEFILE "" TEAISH_MAKEFILE_IN "" - TEAISH_TCL "" - TEAISH_CFLAGS "" - TEAISH_LDFLAGS "" - TEAISH_SRC "" TEAISH_DIST_FILES "" TEAISH_PKGINIT_TCL "" + TEAISH_PKGINIT_TCL_IN "" TEAISH_PKGINDEX_TCL_IN "" TEAISH_PKGINDEX_TCL "" - EXTRA_CFLAGS "" + TEAISH_TCL "" + TEAISH_CFLAGS "" + TEAISH_LDFLAGS "" + TEAISH_SRC "" } { define $f $v } set gotExt 0; # True if an extension config is found - if {![teaish__argv-has --teaish-create-extension*]} { + if {![teaish__argv_has --teaish-create-extension* --t-c-e*]} { + # Don't look for an extension if we're in --t-c-e mode set gotExt [teaish__find-extension] } @@ -177,7 +180,7 @@ proc teaish-configure-core {} { set ::teaish__Config(debug-enabled) [opt-bool teaish-debug] if {[proj-opt-was-provided teaish-create-extension]} { - teaish__create-extension [opt-val teaish-create-extension] + teaish__create_extension [opt-val teaish-create-extension] return } proj-assert {1==$gotExt} "Else we cannot have gotten this far" @@ -305,7 +308,7 @@ proc teaish__configure-finalize {} { # # Ensure we have a pkgIndex.tcl and don't have a stale generated one # when rebuilding for different --with-tcl=... values. Also take - # care not to nuke it if pkgindex-policy is 1. + # care not to nuke it if pkgindex-policy is 0x10. # apply {{} { set policy $::teaish__Config(pkgindex-policy); @@ -313,7 +316,6 @@ proc teaish__configure-finalize {} { if {$policy & 0x10} { # teaish-pragma --have-own-pkgIndex.tcl override. This means # we have a static/non-generated pkgIndex.tcl. - define TEAISH_PKGINDEX_TCL_IN "" set tpt [get-define TEAISH_PKGINDEX_TCL ""] if {"" eq $tpt} { set tpt [file join [get-define TEAISH_DIR] pkgIndex.tcl] @@ -321,11 +323,11 @@ proc teaish__configure-finalize {} { } set src $tpt } elseif {$policy & 0x04} { - # Found output file in TEAISH_DIR but no input file, so + # Found TEAISH_DIR/pkgIndex.tcl but no pkgIndex.tcl.in, so # assume it's a hand-written one. set src [get-define TEAISH_PKGINDEX_TCL] } elseif {$policy} { - # Found input pkgIndex.tcl.in TEAISH_DIR or srcdir + # Found one of {TEAISH_DIR,srcdir}/pkgIndex.tcl.in set src [get-define TEAISH_PKGINDEX_TCL_IN] } else { proj-fatal "Cannot determine the pkgIndex.tcl to use" @@ -602,77 +604,50 @@ proc teaish__find-extension {} { # be loaded before [options] is run (so that the extension can # inject its own options). # - set largv {}; # rewritten $::argv set extM ""; # teaish.make.in set extT ""; # teaish.tcl - set lambdaM {{f} { - if {[file isdir $f]} { - set f [file join $f teaish.make.in] - } - if {[file readable $f]} { - return [file-normalize $f] + # Helper for the foreach loop below. + set lambdaMT {{mustHave fid dir} { + if {[file isdir $dir]} { + set f [file join $dir $fid] + if {[file readable $f]} { + return [file-normalize $f] + } elseif {$mustHave} { + proj-fatal "Missing required $dir/$fid" + } + } elseif {$mustHave} { + proj-fatal "--teaish-extension-dir=$dir does not reference a directory" } return "" }} - set lambdaT {{f} { - if {[file isdir $f]} { - set f [file join $f teaish.tcl] - } - if {![file readable $f]} { - proj-fatal "extension tcl file is not readable: $f" - } - return [file-normalize $f] - }} -# set gotNonFlag 0 + set largv {}; # rewritten $::argv foreach arg $::argv { #puts "*** arg=$arg" switch -glob -- $arg { --ted=* - --t-e-d=* - --teaish-extension-dir=* { + # Ensure that $extD refers to a directory and contains a + # teaish.tcl. regexp -- {--[^=]+=(.+)} $arg - extD set extD [file-normalize $extD] if {![file isdir $extD]} { proj-fatal "--teaish-extension-dir value is not a directory: $extD" } - set extM [apply $lambdaM [file join $extD teaish.make.in]] - set extT [apply $lambdaT [file join $extD teaish.tcl]] + set extM [apply $lambdaMT 0 teaish.make.in $extD] + set extT [apply $lambdaMT 1 teaish.tcl $extD] define TEAISH_DIR $extD } default { - # We'd like to treat the first non-flag argument as - # --teaish-extension-dir, but autosetup does not accept args - # except in the form --flag or X=Y lappend largv $arg -# -# --* { -# lappend largv $arg -# } -# default { -# if {$gotNonFlag || "" ne $extT} { -# lappend largv $arg -# } else { -# incr gotNonFlag -# msg-checking "Treating fist non-flag argument as --teaish-extension-dir ... " -# if {[catch [set extD [file-normalize $arg]]]} { -# msg-result "dir name not normalizable: $arg" -# lappend largv $arg -# } else { -# set extM [apply $lambdaM [file join $arg teaish.make.in]] -# set extT [apply $lambdaT [file join $arg teaish.tcl]] -# define TEAISH_DIR $extD -# msg-result "$arg" -# } -# } -# } } } } set ::argv $largv - set dbld $::autosetup(builddir); # dir we're configuring under - set dsrc $::autosetup(srcdir); # where teaish's configure script lives - set dext [get-define TEAISH_DIR $dbld] ; # dir with the extension - set extEqSrc [expr {$dext eq $dsrc}] ; # are we building in-tree vis-a-vis teaish core? + set dirBld $::autosetup(builddir); # dir we're configuring under + set dirSrc $::autosetup(srcdir); # where teaish's configure script lives + set dirExt [get-define TEAISH_DIR $dirBld] ; # dir with the extension + set extEqSrc [expr {$dirExt eq $dirSrc}] ; # are we building in-tree vis-a-vis teaish core? # # teaish.tcl is a TCL script which implements various @@ -681,33 +656,34 @@ proc teaish__find-extension {} { # We use the first one we find in the builddir or srcdir. # if {"" eq $extT} { - set flist [list $dext/teaish.tcl] + set flist [list $dirExt/teaish.tcl] if {!$extEqSrc} { - lappend flist $dsrc/teaish.tcl + lappend flist $dirSrc/teaish.tcl } if {![proj-first-file-found $flist extT]} { if {"--help" in $::argv} { - return 0 + return 0; # signals teaish-configure-core to process --help } proj-indented-notice -error " Did not find any of: $flist -If you are attempting an out-of-tree build, be sure to -use --teaish-extension-dir=/path/to/extension" +If you are attempting an out-of-tree build, use + --teaish-extension-dir=/path/to/extension" } } if {![file readable $extT]} { proj-fatal "extension tcl file is not readable: $extT" } - msg-result "Extension config = $extT" define TEAISH_TCL $extT if {"" eq [get-define TEAISH_DIR ""]} { # If this wasn't set via --teaish-extension-dir then derive it from # $extT. - #puts "extT=$extT dext=$dext" - set dext [file dirname $extT] - define TEAISH_DIR $dext + #puts "extT=$extT dirExt=$dirExt" + set dirExt [file dirname $extT] + define TEAISH_DIR $dirExt } + msg-result "Extension dir = [get-define TEAISH_DIR]" + msg-result "Extension config = $extT" # # teaish.make provides some of the info for the main makefile, @@ -717,9 +693,9 @@ use --teaish-extension-dir=/path/to/extension" # the builddir or the srcdir. # if {"" eq $extM} { - set flist [list $dext/teaish.make.in] + set flist [list $dirExt/teaish.make.in] if {!$extEqSrc} { - lappend flist $dsrc/teaish.make.in + lappend flist $dirSrc/teaish.make.in } proj-first-file-found $flist extM } @@ -727,15 +703,15 @@ use --teaish-extension-dir=/path/to/extension" define TEAISH_MAKEFILE_IN $extM define TEAISH_MAKEFILE [file rootname [file tail $extM]] proj-dot-ins-append $extM [get-define TEAISH_MAKEFILE] - msg-result "Extension makefile = $extM" + msg-result "Extension makefile = $extM" } else { define TEAISH_MAKEFILE_IN "" define TEAISH_MAKEFILE "" - #proj-warn "Did not find an teaish.make.in." + #proj-warn "Did not find a teaish.make.in." } # Look for teaish.pkginit.tcl - set flist [list $dext/teaish.pkginit.tcl.in $dext/teaish.pkginit.tcl] + set flist [list $dirExt/teaish.pkginit.tcl.in $dirExt/teaish.pkginit.tcl] if {[proj-first-file-found $flist extI]} { if {[string match *.in $extI]} { proj-dot-ins-append $extI @@ -746,37 +722,34 @@ use --teaish-extension-dir=/path/to/extension" define TEAISH_PKGINIT_TCL $extI } teaish-add-dist [file tail $extI] - msg-result "Extension post-load init = $extI" + msg-result "Extension post-load init = $extI" define TEAISH_PKGINIT_TCL_TAIL [file tail [get-define TEAISH_PKGINIT_TCL]]; # for use in pkgIndex.tcl } # Look for pkgIndex.tcl[.in]... set piPolicy 0 - if {[proj-first-file-found $dext/pkgIndex.tcl.in extPI]} { - # If $dext/pkgIndex.tcl.in exists, generate ./pkgIndex.tcl from + if {[proj-first-file-found $dirExt/pkgIndex.tcl.in extPI]} { + # If $dirExt/pkgIndex.tcl.in exists, generate ./pkgIndex.tcl from # it. define TEAISH_PKGINDEX_TCL_IN $extPI define TEAISH_PKGINDEX_TCL [file rootname [file tail $extPI]] proj-dot-ins-append $extPI teaish-add-dist [file tail $extPI] set piPolicy 0x01 - } elseif {!$extEqSrc && [proj-first-file-found $dsrc/pkgIndex.tcl.in extPI]} { - # If $dsrc/pkgIndex.tcl.in exists, generate ./pkgIndex.tcl from + } elseif {!$extEqSrc && [proj-first-file-found $dirSrc/pkgIndex.tcl.in extPI]} { + # If $dirSrc/pkgIndex.tcl.in exists, generate ./pkgIndex.tcl from # it. define TEAISH_PKGINDEX_TCL_IN $extPI define TEAISH_PKGINDEX_TCL [file rootname [file tail $extPI]] proj-dot-ins-append $extPI set piPolicy 0x02 - } - if {!$piPolicy } { - if {[proj-first-file-found $dext/pkgIndex.tcl extPI]} { - # if TEAISH_DIR/pkgIndex.tcl exists, assume it's a static file - # and use it. - define TEAISH_PKGINDEX_TCL_IN "" - define TEAISH_PKGINDEX_TCL $extPI - proj-dot-ins-append $extPI - set piPolicy 0x04 - } + } elseif {[proj-first-file-found $dirExt/pkgIndex.tcl extPI]} { + # if TEAISH_DIR/pkgIndex.tcl exists, assume it's a static file + # and use it. + define TEAISH_PKGINDEX_TCL_IN "" + define TEAISH_PKGINDEX_TCL $extPI + proj-dot-ins-append $extPI + set piPolicy 0x04 } set ::teaish__Config(pkgindex-policy) $piPolicy @@ -946,53 +919,108 @@ proc teaish-make-config-header {filename} { proj-touch $filename; # help avoid frequent unnecessary auto-reconfig } -# internal cache for feature checks. -array set teaish__fCache {} - -# @teaish-feature-cache-set ?$depth? value +# @teaish-feature-cache-set ?$key? value # -# Sets a feature-check cache entry with a key equal to -# [proj-current-scope [expr {$depth+1}]] and the given value. -proc teaish-feature-cache-set {{depth 0} val} { - set key [proj-current-scope [expr {$depth + 1}]] - #puts "** fcheck set key=$key = $val" - set ::teaish__fCache($key) $val +# Sets a feature-check cache entry with the given key. +# See proj-cache-set for the key's semantics. +proc teaish-feature-cache-set {{key 0} val} { + proj-cache-set $key 1 $val } -# @teaish-feature-cache-check ?$depth? tgtVarName +# @teaish-feature-cache-check ?$key? tgtVarName +# +# Checks for a feature-check cache entry with the given key. +# See proj-cache-set for the key's semantics. # -# If the feature-check cache has an entry named [proj-current-scope -# [expr {$depth+1}]] then this function assigns its value to tgtVar and -# returns 1, else it assigns tgtVar to "" and returns 0. +# If the feature-check cache has a matching entry then this function +# assigns its value to tgtVar and returns 1, else it assigns tgtVar to +# "" and returns 0. # -proc teaish-feature-cache-check {{depth 0} tgtVar} { +# See proj-cache-check for $key's semantics. +proc teaish-feature-cache-check {{key 0} tgtVar} { upvar $tgtVar tgt - set key [proj-current-scope [expr {$depth + 1}]] - #puts "** fcheck get key=$key" - if {[info exists ::teaish__fCache($key)]} { - set tgt $::teaish__fCache($key) - return 1 + proj-cache-check $key 1 tgt +} + +# @teaish-check-cached@ ?-nostatus? msg script +# +# A proxy for feature-test impls which handles caching of a feature +# flag check on per-function basis, using the calling scope's name as +# the cache key. +# +# It emits [msg-checking $msg]. If $msg is empty then it defaults to +# the name of the caller's scope. At the end, it will [msg-result "ok"] +# [msg-result "no"] unless -nostatus is used, in which case the caller +# is responsible for emitting at least a newline when it's done. +# +# This function checks for a cache hit before running $script and +# caching the result. If no hit is found then $script is run in the +# calling scope and its result value is stored in the cache. This +# routine will intercept a 'return' from $script. +# +# Flags: +# +# -nostatus = do not emit "ok" or "no" at the end. This presumes +# that the caller will emit at least one newline before turning. +proc teaish-check-cached {args} { + set quiet 0 + set xargs {} + foreach arg $args { + switch -exact -- $arg { + -nostatus { + incr quiet + } + default { + lappend xargs $arg + } + } + } + lassign $xargs msg script + if {"" eq $msg} { + set msg [proj-current-scope 1] + } + msg-checking "${msg} ... " + if {[teaish-feature-cache-check 1 check]} { + msg-checking "(cached) " + if {$check} {msg-result "ok"} else {msg-result "no"} + return $check + } else { + set code [catch {uplevel 1 $script} rc xopt] + #puts "***** cached-check got code=$code rc=$rc" + if {$code in {0 2}} { + teaish-feature-cache-set 1 $rc + if {!$quiet} { + if {$rc} { + msg-result "ok" + } else { + msg-result "no" + } + } + } else { + #puts "**** code=$code rc=$rc xopt=$xopt" + teaish-feature-cache-set 1 0 + } + #puts "**** code=$code rc=$rc" + return {*}$xopt $rc } - set tgtVar "" - return 0 } ######################################################################## -# Internal helper for teaish__defs-format_: returns a JSON-ish quoted +# Internal helper for teaish__defs_format_: returns a JSON-ish quoted # form of the given string-type values. It only performs the most # basic of escaping. The input must not contain any control # characters. -proc teaish__quote-str {value} { +proc teaish__quote_str {value} { return \"[string map [list \\ \\\\ \" \\\"] $value]\" } ######################################################################## -# Internal helper for teaish__dump-defs-json. Expects to be passed a +# Internal helper for teaish__dump_defs_to_list. Expects to be passed a # [define] name and the variadic $args which are passed to -# teaish__dump-defs-json. If it finds a pattern match for the given +# teaish__dump_defs_to_list.. If it finds a pattern match for the given # $name in the various $args, it returns the type flag for that $name, # e.g. "-str" or "-bare", else returns an empty string. -proc teaish__defs-type {name spec} { +proc teaish__defs_type {name spec} { foreach {type patterns} $spec { foreach pattern $patterns { if {[string match $pattern $name]} { @@ -1008,8 +1036,8 @@ proc teaish__defs-type {name spec} { # make-config-header, and a value. Returns the formatted value or the # value $::teaish__Config(defs-skip) if the caller should skip # emitting that value. -set teaish__Config(defs-skip) "-teaish__defs-format sentinel" -proc teaish__defs-format {type value} { +set teaish__Config(defs-skip) "-teaish__defs_format sentinel" +proc teaish__defs_format {type value} { switch -exact -- $type { -bare { # Just output the value unchanged @@ -1018,18 +1046,18 @@ proc teaish__defs-format {type value} { set value $::teaish__Config(defs-skip) } -str { - set value [teaish__quote-str_ $value] + set value [teaish__quote_str_ $value] } -auto { # Automatically determine the type if {![string is integer -strict $value]} { - set value [teaish__quote-str $value] + set value [teaish__quote_str $value] } } -array { set ar {} foreach v $value { - set v [teaish__defs-format -auto $v] + set v [teaish__defs_format -auto $v] if {$::teaish__Config(defs-skip) ne $v} { lappend ar $v } @@ -1065,8 +1093,8 @@ proc teaish__dump_defs_to_list {args} { -bare {SIZEOF_* HAVE_DECL_*} \ -auto * foreach n [lsort [dict keys [all-defines]]] { - set type [teaish__defs-type $n $args] - set value [teaish__defs-format $type [get-define $n]] + set type [teaish__defs_type $n $args] + set value [teaish__defs_format $type [get-define $n]] if {$skipper ne $value} { lappend lines "$n $value" } @@ -1081,13 +1109,15 @@ proc teaish__dump_defs_to_list {args} { # particular those which require changing how the core looks for an # extension and its files. # -# Accepts the following flags: +# Accepts the following flags. Those marked with [L] are safe to use +# during initial loading of tclish.tcl (recall that most teaish APIs +# cannot be used until [teaish-configure] is called). # -# --have-own-pkgIndex.tcl: Tells teaish that ./pkgIndex.tcl is not a -# generated file, so it will not try to overwrite or delete it. -# May be used during initial loading of teaish.tcl. +# --have-own-pkgIndex.tcl [L]: Tells teaish that ./pkgIndex.tcl is +# not a generated file, so it will not try to overwrite or delete +# it. # -# --disable-dist: disables the "dist" parts of the filtered +# --disable-dist [L]: disables the "dist" parts of the filtered # Makefile. May be used during initial loading of teaish.tcl. # # Emits a warning message for unknown arguments. @@ -1132,17 +1162,27 @@ proc teaish-enable-dist {{yes 1}} { # # Handles --teaish-create-extension=TARGET-DIR # -proc teaish__create-extension {dir} { +proc teaish__create_extension {dir} { set force [opt-bool teaish-force] + if {"" eq $dir} { + proj-fatal "--teaish-create-extension=X requires a directory name." + } file mkdir $dir set cwd [pwd] - set dir [file-normalize [file join $cwd $dir]] + #set dir [file-normalize [file join $cwd $dir]] msg-result "Created dir $dir" cd $dir - set flist {teaish.tcl} - foreach f $flist { - if {!$force && [file exists $f]} { - error "Cowardly refusing to overwrite $dir/$f. Use --teaish-force to overwrite." + if {!$force} { + # Ensure that we don't blindly overwrite anything + foreach f { + teaish.c + teaish.tcl + teaish.make.in + teaish.test.tcl + } { + if {[file exists $f]} { + error "Cowardly refusing to overwrite $dir/$f. Use --teaish-force to overwrite." + } } } diff --git a/autoconf/tea/autosetup/feature-tests.tcl b/autoconf/tea/autosetup/feature-tests.tcl index b2f9d84660..7fac7a6acd 100644 --- a/autoconf/tea/autosetup/feature-tests.tcl +++ b/autoconf/tea/autosetup/feature-tests.tcl @@ -16,65 +16,6 @@ # private/internal APIs. Those with a prefix of teaish- are # public APIs. -# @teaish-check-cached@ ?-flags? msg script -# -# A proxy for feature-test impls which handles caching of a feature -# flag check on per-function basis, using the calling scope's name as -# the cache key. -# -# The test is performed by $script. This function checks for a chache -# hit before running $script and caching the result. The value stored -# in the cache is the final value of $script (and this routine will -# intercept a 'return' from $script). -# -# Flags: -# -# -nostatus = do not emit "ok" or "no" at the end. This presumes -# that the caller will emit at least one newline before turning. -proc teaish-check-cached {args} { - set quiet 0 - set xargs {} - foreach arg $args { - switch -exact -- $arg { - -nostatus { - incr quiet - } - default { - lappend xargs $arg - } - } - } - lassign $xargs msg script - if {"" eq $msg} { - set msg [proj-current-scope 1] - } - msg-checking "${msg} ... " - if {[teaish-feature-cache-check 1 check]} { - msg-checking "(cached) " - if {$check} {msg-result "ok"} else {msg-result "no"} - return $check - } else { - set code [catch {uplevel 1 $script} rc xopt] - #puts "***** ::teaish__fCache ="; parray ::teaish__fCache - #puts "***** cached-check got code=$code rc=$rc" - if {$code in {0 2}} { - teaish-feature-cache-set 1 $rc - if {!$quiet} { - if {$rc} { - msg-result "ok" - } else { - msg-result "no" - } - } - } else { - #puts "**** code=$code rc=$rc xopt=$xopt" - teaish-feature-cache-set 1 0 - } - #puts "**** code=$code rc=$rc" - return {*}$xopt $rc - } -} - # @teaish-check-libz # diff --git a/autosetup/proj.tcl b/autosetup/proj.tcl index d64cc62186..3d580b07c4 100644 --- a/autosetup/proj.tcl +++ b/autosetup/proj.tcl @@ -58,7 +58,9 @@ # $proj__Config is an internal-use-only array for storing whatever generic # internal stuff we need stored. array set proj__Config { + self-tests 0 } + # # List of dot-in files to filter in the final stages of # configuration. Some configuration steps may append to this. Each @@ -1795,3 +1797,103 @@ proc proj-options-combine {args} { } return $rv } + +# Internal cache for use via proj-cache-*. +array set proj__Cache {} + +# @proj-cache-key ?addLevel? arg +# +# Helper to generate cache keys for [proj-cache-*]. +# +# Returns a cache key for the given argument: +# +# integer: relative call stack levels to get the scope name of for +# use as a key. [proj-current-scope [expr {1 + $arg + addLevel}]] is +# then used to generate the key. i.e. the default of 0 uses the +# calling scope's name as the key. +# +# "-": same as 0 +# +# Anything else: returned as-is +# +proc proj-cache-key {{addLevel 0} arg} { + if {"-" eq $arg} {set arg 0} + if {[string is integer -strict $arg]} { + return [proj-current-scope [expr {$arg + $addLevel + 1}]] + } + return $arg +} + +# @proj-cache-set ?key? ?addLevel? value +# +# Sets a feature-check cache entry with the given key. +# +# 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-set {{key 0} {addLevel 0} val} { + set key [proj-cache-key [expr {1 + $addLevel}] $key] + #puts "** fcheck set $key = $val" + set ::proj__Cache($key) $val +} + +# @proj-cache-remove ?key? ?addLevel? +# +# Removes an entry from the proj-cache. +proc proj-cache-remove {{key 0} {addLevel 0}} { + set key [proj-cache-key [expr {1 + $addLevel}] $key] + set rv "" + if {[info exists ::proj__Cache($key)]} { + set rv $::proj__Cache($key) + unset ::proj__Cache($key) + } + return $rv; +} + +# @proj-cache-check ?$key? ?addLevel? tgtVarName +# +# Checks for a feature-check cache entry with the given key. +# +# If the feature-check cache has a matching entry then this function +# assigns its value to tgtVar and returns 1, else it assigns tgtVar to +# "" and returns 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 {{key 0} {addLevel 0} tgtVar} { + upvar $tgtVar tgt + set rc 0 + set key [proj-cache-key [expr {1 + $addLevel}] $key] + #puts "** fcheck get key=$key" + if {[info exists ::proj__Cache($key)]} { + set tgt $::proj__Cache($key) + incr rc + } else { + set tgt "" + } + return $rc +} + +if {$::proj__Config(self-tests)} { + apply {{} { + proj-warn "Test code for proj-cache" + proj-assert {![proj-cache-check here check]} + proj-assert {"here" eq [proj-cache-key here]} + proj-assert {"" eq $check} + proj-cache-set here thevalue + proj-assert {[proj-cache-check here check]} + proj-assert {"thevalue" eq $check} + + proj-assert {![proj-cache-check check]} + #puts "*** key = ([proj-cache-key -])" + proj-assert {"" eq $check} + proj-cache-set abc + proj-assert {[proj-cache-check check]} + proj-assert {"abc" eq $check} + + parray ::proj__Cache; + proj-assert {"" ne [proj-cache-remove]} + proj-assert {"" eq [proj-cache-remove]} + proj-assert {![proj-cache-check check]} + proj-assert {"" eq $check} + }} +} diff --git a/manifest b/manifest index 4a867fff84..e51001db89 100644 --- a/manifest +++ b/manifest @@ -1,5 +1,5 @@ -C Avoid\sa\spotential\sinteger\soverflow\sin\snon-default\sbuilds\sof\sthe\sfts3\smatchinfo()\sfunction. -D 2025-04-15T11:06:37.142 +C Cleanups\sand\srefactoring\sin\sproj.tcl\sand\steaish. +D 2025-04-15T15:20:30.333 F .fossil-settings/binary-glob 61195414528fb3ea9693577e1980230d78a1f8b0a54c78cf1b9b24d0a409ed6a x F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea @@ -26,8 +26,8 @@ F autoconf/tea/Makefile.in 2a90dfab1e95cb3ec610429c78d88d4a7d26beb080ad45ff6a059 F autoconf/tea/README.txt 656d4686c509d375f5988ff3deda94f65fe6cd8358cd55d1f1dcc7b6e2ff73aa F autoconf/tea/auto.def 81e2617cfb90d53c19b53b3ec632cd2893bf32f2e5dd272b1116fadf2ea86c2d F autoconf/tea/autosetup/README.txt b40071e6f8506500a2f7f71d5fc69e0bf87b9d7678dd9da1e5b4d0acbf40b1ca -F autoconf/tea/autosetup/core.tcl 87051761ee1bb11df381751e656f3d86feac3f281e539ec4442ffc4c2758f2f8 -F autoconf/tea/autosetup/feature-tests.tcl f594efeb43fe1d83599367ac388082a1d47be28322591a1d9d29214039df2094 +F autoconf/tea/autosetup/core.tcl b0d2781acbd2bebbcf4baeb4c0a1fae4814e251df7a1b4f4db10e88c57d03eef +F autoconf/tea/autosetup/feature-tests.tcl 87b448e620b043c8c23b6cb727a3a5e485b61b600077222b6799e9f64aab941a F autoconf/tea/autosetup/tester.tcl d94aa9d51d2a22062e61db97310c2502ca0df50ca87108482c3bccf8f41db127 F autoconf/tea/configure d0b12b984edca6030d1976375b80157ac78b5b90a5b4f0dcee39357f63f4a80b x F autoconf/tea/doc/sqlite3.n 9a97f4f717ceab73004ea412af7960625c1cb24b5c25e4ae4c8b5d8fa4300f4e @@ -51,7 +51,7 @@ F autosetup/cc.tcl c0fcc50ca91deff8741e449ddad05bcd08268bc31177e613a6343bbd1fd3e F autosetup/find_tclconfig.tcl e64886ffe3b982d4df42cd28ed91fe0b5940c2c5785e126c1821baf61bc86a7e F autosetup/jimsh0.c a57c16e65dcffc9c76e496757cb3f7fb47e01ecbd1631a0a5e01751fc856f049 F autosetup/pkg-config.tcl 4e635bf39022ff65e0d5434339dd41503ea48fc53822c9c5bde88b02d3d952ba -F autosetup/proj.tcl 4902c308f0b8fe8d734247f38253aa0cf46fee63834074b2b0ff90d092b4add0 +F autosetup/proj.tcl 3e9f84104d401a353f53961db7d361469bf6d614897c11144aecedc9727120d3 F autosetup/sqlite-config.tcl d4e888fc94e677e3820fea998747c94b8dcc4ff346a14253bf7f5344f526ceef F autosetup/system.tcl 51d4be76cd9a9074704b584e5c9cbba616202c8468cf9ba8a4f8294a7ab1dba9 F configure 9a00b21dfd13757bbfb8d89b30660a89ec1f8f3a79402b8f9f9b6fc475c3303a x @@ -2216,8 +2216,8 @@ F tool/version-info.c 3b36468a90faf1bbd59c65fd0eb66522d9f941eedd364fabccd7227350 F tool/warnings-clang.sh bbf6a1e685e534c92ec2bfba5b1745f34fb6f0bc2a362850723a9ee87c1b31a7 F tool/warnings.sh 49a486c5069de041aedcbde4de178293e0463ae9918ecad7539eedf0ec77a139 F tool/win/sqlite.vsix deb315d026cc8400325c5863eef847784a219a2f -P 07e9ceee51380ee25e580178fa82030be5d2b65d4f4b4dc86c94b21f7f04f291 -R 84dac09860d04f3b89dac3e5a6e35be6 -U dan -Z fa2be2a8c187a7c531361e66a41cdaca +P aecc0100cef3ea83feed558dbe34dd6313721fa54052ee1ed529741cec8cacda +R 6d0851af6d222d7402138880b42a71fb +U stephan +Z eb37c816b2f5ad3c81b2db656b75bd7f # Remove this line to create a well-formed Fossil manifest. diff --git a/manifest.uuid b/manifest.uuid index 3b0c6fc0db..0ce230b4dd 100644 --- a/manifest.uuid +++ b/manifest.uuid @@ -1 +1 @@ -aecc0100cef3ea83feed558dbe34dd6313721fa54052ee1ed529741cec8cacda +6b7ca8176e8c1b5e99e177c3daaba47b0674fa2f82d91754e7a8f66460ca8419