]> git.ipfire.org Git - thirdparty/sqlite.git/commitdiff
Cleanups and refactoring in proj.tcl and teaish.
authorstephan <stephan@noemail.net>
Tue, 15 Apr 2025 15:20:30 +0000 (15:20 +0000)
committerstephan <stephan@noemail.net>
Tue, 15 Apr 2025 15:20:30 +0000 (15:20 +0000)
FossilOrigin-Name: 6b7ca8176e8c1b5e99e177c3daaba47b0674fa2f82d91754e7a8f66460ca8419

autoconf/tea/autosetup/core.tcl
autoconf/tea/autosetup/feature-tests.tcl
autosetup/proj.tcl
manifest
manifest.uuid

index ad7e942e546c20c568d54de43096d708456d6ffb..c265e50a58738c945579d8144ff641a33b2d2b15 100644 (file)
@@ -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."
+      }
     }
   }
 
index b2f9d84660d0fcc5c688760ef308b6167d28aac8..7fac7a6acd6c176d3ceb968a2207894a3fc886ec 100644 (file)
 # 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
 #
index d64cc6218696bc8664f45585818cc1a78a42f126..3d580b07c4121ca2b43567aa021939a8ad631566 100644 (file)
@@ -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}
+  }}
+}
index 4a867fff84bfabcce5eba90a1fe53bc7673ede26..e51001db89f77ebbcecd5a87b9f6e4c46af2a6a7 100644 (file)
--- 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.
index 3b0c6fc0db5b09ef7360ab7ba238f6969f3ffb03..0ce230b4dd738dfe21ad2bf36d6959c41f9a0f8a 100644 (file)
@@ -1 +1 @@
-aecc0100cef3ea83feed558dbe34dd6313721fa54052ee1ed529741cec8cacda
+6b7ca8176e8c1b5e99e177c3daaba47b0674fa2f82d91754e7a8f66460ca8419