Mercurial
diff third_party/sqlite3/autosetup/proj.tcl @ 167:589bab390fb4
[ThirdParty] Added sqlite3 to the third_party.
| author | MrJuneJune <me@mrjunejune.com> |
|---|---|
| date | Mon, 19 Jan 2026 16:28:45 -0800 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/third_party/sqlite3/autosetup/proj.tcl Mon Jan 19 16:28:45 2026 -0800 @@ -0,0 +1,2549 @@ +######################################################################## +# 2024 September 25 +# +# The author disclaims copyright to this source code. In place of +# a legal notice, here is a blessing: +# +# * May you do good and not evil. +# * May you find forgiveness for yourself and forgive others. +# * May you share freely, never taking more than you give. +# + +# +# ----- @module proj.tcl ----- +# @section Project-agnostic Helper APIs +# + +# +# Routines for Steve Bennett's autosetup which are common to trees +# managed in and around the umbrella of the SQLite project. +# +# The intent is that these routines be relatively generic, independent +# of a given project. +# +# For practical purposes, the copy of this file hosted in the SQLite +# project is the "canonical" one: +# +# https://sqlite.org/src/file/autosetup/proj.tcl +# +# This file was initially derived from one used in the libfossil +# project, authored by the same person who ported it here, and this is +# noted here only as an indication that there are no licensing issues +# despite this code having a handful of near-twins running around a +# handful of third-party source trees. +# +# Design notes: +# +# - Symbols with _ separators are intended for internal use within +# this file, and are not part of the API which auto.def files should +# rely on. Symbols with - separators are public APIs. +# +# - By and large, autosetup prefers to update global state with the +# results of feature checks, e.g. whether the compiler supports flag +# --X. In this developer's opinion that (A) causes more confusion +# than it solves[^1] and (B) adds an unnecessary layer of "voodoo" +# between the autosetup user and its internals. This module, in +# contrast, instead injects the results of its own tests into +# well-defined variables and leaves the integration of those values +# to the caller's discretion. +# +# [1]: As an example: testing for the -rpath flag, using +# cc-check-flags, can break later checks which use +# [cc-check-function-in-lib ...] because the resulting -rpath flag +# implicitly becomes part of those tests. In the case of an rpath +# test, downstream tests may not like the $prefix/lib path added by +# the rpath test. To avoid such problems, we avoid (intentionally) +# updating global state via feature tests. +# + +# +# $proj__Config is an internal-use-only array for storing whatever generic +# internal stuff we need stored. +# +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 +# configuration. Some configuration steps may append to this. Each +# one in this list which exists will trigger the generation of a +# file with that same name, minus the ".in", in the build directory +# (which differ from the source dir in out-of-tree builds). +# +# See: proj-dot-ins-append and proj-dot-ins-process +# +set ::proj__Config(dot-in-files) [list] + +# +# @proj-warn msg +# +# Emits a warning message to stderr. All args are appended with a +# space between each. +# +proc proj-warn {args} { + show-notices + 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 args} { + show-notices + set lvl 1 + while {"-up" eq [lindex $args 0]} { + set args [lassign $args -] + incr lvl + } + if {$failMode} { + puts stderr [join [list "FATAL:" \[ [proj-scope $lvl] \]: {*}$args]] + exit 1 + } else { + error [join [list in \[ [proj-scope $lvl] \]: {*}$args]] + } +} + +# +# @proj-fatal ?-up...? msg... +# +# Emits an error message to stderr and exits with non-0. All args are +# appended with a space between each. +# +# The calling scope's name is used in the error message. To instead +# use the name of a call higher up in the stack, use -up once for each +# additional level. +# +proc proj-fatal {args} { + tailcall proj__faterr 1 {*}$args +} + +# +# @proj-error ?-up...? msg... +# +# Works like proj-fatal but uses [error] intead of [exit]. +# +proc proj-error {args} { + tailcall proj__faterr 0 {*}$args +} + +# +# @proj-assert script ?message? +# +# Kind of like a C assert: if uplevel of [list expr $script] is false, +# a fatal error is triggered. The error message, by default, includes +# the body of the failed assertion, but if $msg is set then that is +# used instead. +# +proc proj-assert {script {msg ""}} { + if {1 eq $::proj__Config(verbose-assert)} { + msg-result [proj-bold "asserting: $script"] + } + if {![uplevel 1 [list expr $script]]} { + if {"" eq $msg} { + set msg $script + } + tailcall proj__faterr 1 "Assertion failed:" $msg + } +} + +# +# @proj-bold str +# +# If this function believes that the current console might support +# ANSI escape sequences then this returns $str wrapped in a sequence +# to bold that text, else it returns $str as-is. +# +proc proj-bold {args} { + if {$::autosetup(iswin) || !$::proj__Config(isatty)} { + return [join $args] + } + return "\033\[1m${args}\033\[0m" +} + +# +# @proj-indented-notice ?-error? ?-notice? msg +# +# Takes a multi-line message and emits it with consistent indentation. +# It does not perform any line-wrapping of its own. Which output +# routine it uses depends on its flags, defaulting to msg-result. +# For -error and -notice it uses user-notice. +# +# If the -notice flag it used then it emits using [user-notice], which +# means its rendering will (A) go to stderr and (B) be delayed until +# the next time autosetup goes to output a message. +# +# If the -error flag is provided then it renders the message +# immediately to stderr and then exits. +# +# If neither -notice nor -error are used, the message will be sent to +# stdout without delay. +# +proc proj-indented-notice {args} { + set fErr "" + set outFunc "msg-result" + while {[llength $args] > 1} { + switch -exact -- [lindex $args 0] { + -error { + set args [lassign $args fErr] + set outFunc "user-notice" + } + -notice { + set args [lassign $args -] + set outFunc "user-notice" + } + default { + break + } + } + } + set lines [split [join $args] \n] + foreach line $lines { + set line [string trimleft $line] + if {"" eq $line} { + $outFunc $line + } else { + $outFunc " $line" + } + } + if {"" ne $fErr} { + show-notices + exit 1 + } +} + +# +# @proj-is-cross-compiling +# +# Returns 1 if cross-compiling, else 0. +# +proc proj-is-cross-compiling {} { + expr {[get-define host] ne [get-define build]} +} + +# +# @proj-strip-hash-comments value +# +# Expects to receive string input, which it splits on newlines, strips +# out any lines which begin with any number of whitespace followed by +# a '#', and returns a value containing the [append]ed results of each +# remaining line with a \n between each. It does not strip out +# comments which appear after the first non-whitespace character. +# +proc proj-strip-hash-comments {val} { + set x {} + foreach line [split $val \n] { + if {![string match "#*" [string trimleft $line]]} { + append x $line \n + } + } + return $x +} + +# +# @proj-cflags-without-werror +# +# Fetches [define $var], strips out any -Werror entries, and returns +# the new value. This is intended for temporarily stripping -Werror +# from CFLAGS or CPPFLAGS within the scope of a [define-push] block. +# +proc proj-cflags-without-werror {{var CFLAGS}} { + set rv {} + foreach f [get-define $var ""] { + switch -exact -- $f { + -Werror {} + default { lappend rv $f } + } + } + join $rv " " +} + +# +# @proj-check-function-in-lib +# +# A proxy for cc-check-function-in-lib with the following differences: +# +# - Does not make any global changes to the LIBS define. +# +# - Strips out the -Werror flag from CFLAGS before running the test, +# as these feature tests will often fail if -Werror is used. +# +# Returns the result of cc-check-function-in-lib (i.e. true or false). +# The resulting linker flags are stored in the [define] named +# lib_${function}. +# +proc proj-check-function-in-lib {function libs {otherlibs {}}} { + set found 0 + define-push {LIBS CFLAGS} { + #puts "CFLAGS before=[get-define CFLAGS]" + define CFLAGS [proj-cflags-without-werror] + #puts "CFLAGS after =[get-define CFLAGS]" + set found [cc-check-function-in-lib $function $libs $otherlibs] + } + return $found +} + +# +# @proj-search-for-header-dir ?-dirs LIST? ?-subdirs LIST? header +# +# Searches for $header in a combination of dirs and subdirs, specified +# by the -dirs {LIST} and -subdirs {LIST} flags (each of which have +# sane defaults). Returns either the first matching dir or an empty +# string. The return value does not contain the filename part. +# +proc proj-search-for-header-dir {header args} { + set subdirs {include} + set dirs {/usr /usr/local /mingw} +# Debatable: +# if {![proj-is-cross-compiling]} { +# lappend dirs [get-define prefix] +# } + while {[llength $args]} { + switch -exact -- [lindex $args 0] { + -dirs { set args [lassign $args - dirs] } + -subdirs { set args [lassign $args - subdirs] } + default { + proj-error "Unhandled argument: $args" + } + } + } + foreach dir $dirs { + foreach sub $subdirs { + if {[file exists $dir/$sub/$header]} { + return "$dir/$sub" + } + } + } + return "" +} + +# +# @proj-find-executable-path ?-v? binaryName +# +# Works similarly to autosetup's [find-executable-path $binName] but: +# +# - If the first arg is -v, it's verbose about searching, else it's quiet. +# +# Returns the full path to the result or an empty string. +# +proc proj-find-executable-path {args} { + set binName $args + set verbose 0 + if {[lindex $args 0] eq "-v"} { + set verbose 1 + set args [lassign $args - binName] + msg-checking "Looking for $binName ... " + } + set check [find-executable-path $binName] + if {$verbose} { + if {"" eq $check} { + msg-result "not found" + } else { + msg-result $check + } + } + return $check +} + +# +# @proj-bin-define binName ?defName? +# +# Uses [proj-find-executable-path $binName] to (verbosely) search for +# a binary, sets a define (see below) to the result, and returns the +# result (an empty string if not found). +# +# The define'd name is: If $defName is not empty, it is used as-is. If +# $defName is empty then "BIN_X" is used, where X is the upper-case +# form of $binName with any '-' characters replaced with '_'. +# +proc proj-bin-define {binName {defName {}}} { + set check [proj-find-executable-path -v $binName] + if {"" eq $defName} { + set defName "BIN_[string toupper [string map {- _} $binName]]" + } + define $defName $check + return $check +} + +# +# @proj-first-bin-of bin... +# +# Looks for the first binary found of the names passed to this +# function. If a match is found, the full path to that binary is +# returned, else "" is returned. +# +# Despite using cc-path-progs to do the search, this function clears +# any define'd name that function stores for the result (because the +# caller has no sensible way of knowing which [define] name it has +# unless they pass only a single argument). +# +proc proj-first-bin-of {args} { + set rc "" + foreach b $args { + set u [string toupper $b] + # Note that cc-path-progs defines $u to "false" if it finds no + # match. + if {[cc-path-progs $b]} { + set rc [get-define $u] + } + undefine $u + if {"" ne $rc} break + } + return $rc +} + +# +# @proj-opt-was-provided key +# +# Returns 1 if the user specifically provided the given configure flag +# or if it was specifically set using proj-opt-set, else 0. This can +# be used to distinguish between options which have a default value +# and those which were explicitly provided by the user, even if the +# latter is done in a way which uses the default value. +# +# For example, with a configure flag defined like: +# +# { foo-bar:=baz => {its help text} } +# +# This function will, when passed foo-bar, return 1 only if the user +# passes --foo-bar to configure, even if that invocation would resolve +# to the default value of baz. If the user does not explicitly pass in +# --foo-bar (with or without a value) then this returns 0. +# +# Calling [proj-opt-set] is, for purposes of the above, equivalent to +# explicitly passing in the flag. +# +# Note: unlike most functions which deal with configure --flags, this +# one does not validate that $key refers to a pre-defined flag. i.e. +# it accepts arbitrary keys, even those not defined via an [options] +# call. [proj-opt-set] manipulates the internal list of flags, such +# that new options set via that function will cause this function to +# return true. (That's an unintended and unavoidable side-effect, not +# specifically a feature which should be made use of.) +# +proc proj-opt-was-provided {key} { + dict exists $::autosetup(optset) $key +} + +# +# @proj-opt-set flag ?val? +# +# Force-set autosetup option $flag to $val. The value can be fetched +# later with [opt-val], [opt-bool], and friends. +# +# Returns $val. +# +proc proj-opt-set {flag {val 1}} { + if {$flag ni $::autosetup(options)} { + # We have to add this to autosetup(options) or else future calls + # to [opt-bool $flag] will fail validation of $flag. + lappend ::autosetup(options) $flag + } + dict set ::autosetup(optset) $flag $val + return $val +} + +# +# @proj-opt-exists flag +# +# Returns 1 if the given flag has been defined as a legal configure +# option, else returns 0. Options set via proj-opt-set "exist" for +# this purpose even if they were not defined via autosetup's +# [options] function. +# +proc proj-opt-exists {flag} { + expr {$flag in $::autosetup(options)}; +} + +# +# @proj-val-truthy val +# +# Returns 1 if $val appears to be a truthy value, else returns +# 0. Truthy values are any of {1 on true yes enabled} +# +proc proj-val-truthy {val} { + expr {$val in {1 on true yes enabled}} +} + +# +# @proj-opt-truthy flag +# +# Returns 1 if [opt-val $flag] appears to be a truthy value or +# [opt-bool $flag] is true. See proj-val-truthy. +# +proc proj-opt-truthy {flag} { + if {[proj-val-truthy [opt-val $flag]]} { return 1 } + set rc 0 + catch { + # opt-bool will throw if $flag is not a known boolean flag + set rc [opt-bool $flag] + } + return $rc +} + +# +# @proj-if-opt-truthy boolFlag thenScript ?elseScript? +# +# If [proj-opt-truthy $flag] is true, eval $then, else eval $else. +# +proc proj-if-opt-truthy {boolFlag thenScript {elseScript {}}} { + if {[proj-opt-truthy $boolFlag]} { + uplevel 1 $thenScript + } else { + uplevel 1 $elseScript + } +} + +# +# @proj-define-for-opt flag def ?msg? ?iftrue? ?iffalse? +# +# If [proj-opt-truthy $flag] then [define $def $iftrue] else [define +# $def $iffalse]. If $msg is not empty, output [msg-checking $msg] and +# a [msg-results ...] which corresponds to the result. Returns 1 if +# the opt-truthy check passes, else 0. +# +proc proj-define-for-opt {flag def {msg ""} {iftrue 1} {iffalse 0}} { + if {"" ne $msg} { + msg-checking "$msg " + } + set rcMsg "" + set rc 0 + if {[proj-opt-truthy $flag]} { + define $def $iftrue + set rc 1 + } else { + define $def $iffalse + } + switch -- [proj-val-truthy [get-define $def]] { + 0 { set rcMsg no } + 1 { set rcMsg yes } + } + if {"" ne $msg} { + msg-result $rcMsg + } + return $rc +} + +# +# @proj-opt-define-bool ?-v? optName defName ?descr? +# +# Checks [proj-opt-truthy $optName] and calls [define $defName X] +# where X is 0 for false and 1 for true. $descr is an optional +# [msg-checking] argument which defaults to $defName. Returns X. +# +# If args[0] is -v then the boolean semantics are inverted: if +# the option is set, it gets define'd to 0, else 1. Returns the +# define'd value. +# +proc proj-opt-define-bool {args} { + set invert 0 + if {[lindex $args 0] eq "-v"} { + incr invert + lassign $args - optName defName descr + } else { + lassign $args optName defName descr + } + if {"" eq $descr} { + set descr $defName + } + #puts "optName=$optName defName=$defName descr=$descr" + set rc 0 + msg-checking "[join $descr] ... " + set rc [proj-opt-truthy $optName] + if {$invert} { + set rc [expr {!$rc}] + } + msg-result [string map {0 no 1 yes} $rc] + define $defName $rc + return $rc +} + +# +# @proj-check-module-loader +# +# Check for module-loading APIs (libdl/libltdl)... +# +# Looks for libltdl or dlopen(), the latter either in -ldl or built in +# to libc (as it is on some platforms). Returns 1 if found, else +# 0. Either way, it `define`'s: +# +# - HAVE_LIBLTDL to 1 or 0 if libltdl is found/not found +# - HAVE_LIBDL to 1 or 0 if dlopen() is found/not found +# - LDFLAGS_MODULE_LOADER one of ("-lltdl", "-ldl", or ""), noting +# that -ldl may legally be empty on some platforms even if +# HAVE_LIBDL is true (indicating that dlopen() is available without +# extra link flags). LDFLAGS_MODULE_LOADER also gets "-rdynamic" appended +# to it because otherwise trying to open DLLs will result in undefined +# symbol errors. +# +# Note that if it finds LIBLTDL it does not look for LIBDL, so will +# report only that is has LIBLTDL. +# +proc proj-check-module-loader {} { + msg-checking "Looking for module-loader APIs... " + if {99 ne [get-define LDFLAGS_MODULE_LOADER 99]} { + if {1 eq [get-define HAVE_LIBLTDL 0]} { + msg-result "(cached) libltdl" + return 1 + } elseif {1 eq [get-define HAVE_LIBDL 0]} { + msg-result "(cached) libdl" + return 1 + } + # else: wha??? + } + set HAVE_LIBLTDL 0 + set HAVE_LIBDL 0 + set LDFLAGS_MODULE_LOADER "" + set rc 0 + puts "" ;# cosmetic kludge for cc-check-XXX + if {[cc-check-includes ltdl.h] && [cc-check-function-in-lib lt_dlopen ltdl]} { + set HAVE_LIBLTDL 1 + set LDFLAGS_MODULE_LOADER "-lltdl -rdynamic" + msg-result " - Got libltdl." + set rc 1 + } elseif {[cc-with {-includes dlfcn.h} { + cctest -link 1 -declare "extern char* dlerror(void);" -code "dlerror();"}]} { + msg-result " - This system can use dlopen() without -ldl." + set HAVE_LIBDL 1 + set LDFLAGS_MODULE_LOADER "" + set rc 1 + } elseif {[cc-check-includes dlfcn.h]} { + set HAVE_LIBDL 1 + set rc 1 + if {[cc-check-function-in-lib dlopen dl]} { + msg-result " - dlopen() needs libdl." + set LDFLAGS_MODULE_LOADER "-ldl -rdynamic" + } else { + msg-result " - dlopen() not found in libdl. Assuming dlopen() is built-in." + set LDFLAGS_MODULE_LOADER "-rdynamic" + } + } + define HAVE_LIBLTDL $HAVE_LIBLTDL + define HAVE_LIBDL $HAVE_LIBDL + define LDFLAGS_MODULE_LOADER $LDFLAGS_MODULE_LOADER + return $rc +} + +# +# @proj-no-check-module-loader +# +# Sets all flags which would be set by proj-check-module-loader to +# empty/falsy values, as if those checks had failed to find a module +# loader. Intended to be called in place of that function when +# a module loader is explicitly not desired. +# +proc proj-no-check-module-loader {} { + define HAVE_LIBDL 0 + define HAVE_LIBLTDL 0 + define LDFLAGS_MODULE_LOADER "" +} + +# +# @proj-file-content ?-trim? filename +# +# Opens the given file, reads all of its content, and returns it. If +# the first arg is -trim, the contents of the file named by the second +# argument are trimmed before returning them. +# +proc proj-file-content {args} { + set trim 0 + set fname $args + if {"-trim" eq [lindex $args 0]} { + set trim 1 + lassign $args - fname + } + set fp [open $fname rb] + set rc [read $fp] + close $fp + if {$trim} { return [string trim $rc] } + return $rc +} + +# +# @proj-file-conent filename +# +# Returns the contents of the given file as an array of lines, with +# the EOL stripped from each input line. +# +proc proj-file-content-list {fname} { + set fp [open $fname rb] + set rc {} + while { [gets $fp line] >= 0 } { + lappend rc $line + } + close $fp + return $rc +} + +# +# @proj-file-write ?-ro? fname content +# +# Works like autosetup's [writefile] but explicitly uses binary mode +# to avoid EOL translation on Windows. If $fname already exists, it is +# overwritten, even if it's flagged as read-only. +# +proc proj-file-write {args} { + if {"-ro" eq [lindex $args 0]} { + lassign $args ro fname content + } else { + set ro "" + lassign $args fname content + } + file delete -force -- $fname; # in case it's read-only + set f [open $fname wb] + puts -nonewline $f $content + close $f + if {"" ne $ro} { + catch { + exec chmod -w $fname + #file attributes -w $fname; #jimtcl has no 'attributes' + } + } +} + +# +# @proj-check-compile-commands ?-assume-for-clang? ?configFlag? +# +# Checks the compiler for compile_commands.json support. If +# $configFlag is not empty then it is assumed to be the name of an +# autosetup boolean config which controls whether to run/skip this +# check. +# +# If -assume-for-clang is provided and $configFlag is not empty and CC +# matches *clang* and no --$configFlag was explicitly provided to the +# configure script then behave as if --$configFlag had been provided. +# To disable that assumption, either don't pass -assume-for-clang or +# pass --$configFlag=0 to the configure script. (The reason for this +# behavior is that clang supports compile-commands but some other +# compilers report false positives with these tests.) +# +# Returns 1 if supported, else 0, and defines HAVE_COMPILE_COMMANDS to +# that value. Defines MAKE_COMPILATION_DB to "yes" if supported, "no" +# if not. The use of MAKE_COMPILATION_DB is deprecated/discouraged: +# HAVE_COMPILE_COMMANDS is preferred. +# +# ACHTUNG: this test has a long history of false positive results +# because of compilers reacting differently to the -MJ flag. Because +# of this, it is recommended that this support be an opt-in feature, +# rather than an on-by-default default one. That is: in the +# configure script define the option as +# {--the-flag-name=0 => {Enable ....}} +# +proc proj-check-compile-commands {args} { + set i 0 + set configFlag {} + set fAssumeForClang 0 + set doAssume 0 + msg-checking "compile_commands.json support... " + if {"-assume-for-clang" eq [lindex $args 0]} { + lassign $args - configFlag + incr fAssumeForClang + } elseif {1 == [llength $args]} { + lassign $args configFlag + } else { + proj-error "Invalid arguments" + } + if {1 == $fAssumeForClang && "" ne $configFlag} { + if {[string match *clang* [get-define CC]] + && ![proj-opt-was-provided $configFlag] + && ![proj-opt-truthy $configFlag]} { + proj-indented-notice [subst -nocommands -nobackslashes { + CC appears to be clang, so assuming that --$configFlag is likely + to work. To disable this assumption use --$configFlag=0.}] + incr doAssume + } + } + if {!$doAssume && "" ne $configFlag && ![proj-opt-truthy $configFlag]} { + msg-result "check disabled. Use --${configFlag} to enable it." + define HAVE_COMPILE_COMMANDS 0 + define MAKE_COMPILATION_DB no + return 0 + } else { + if {[cctest -lang c -cflags {/dev/null -MJ} -source {}]} { + # This test reportedly incorrectly succeeds on one of + # Martin G.'s older systems. drh also reports a false + # positive on an unspecified older Mac system. + msg-result "compiler supports -MJ. Assuming it's useful for compile_commands.json" + define MAKE_COMPILATION_DB yes; # deprecated + define HAVE_COMPILE_COMMANDS 1 + return 1 + } else { + msg-result "compiler does not support compile_commands.json" + define MAKE_COMPILATION_DB no + define HAVE_COMPILE_COMMANDS 0 + return 0 + } + } +} + +# +# @proj-touch filename +# +# Runs the 'touch' external command on one or more files, ignoring any +# errors. +# +proc proj-touch {filename} { + catch { exec touch {*}$filename } +} + +# +# @proj-make-from-dot-in ?-touch? infile ?outfile? +# +# Uses [make-template] to create makefile(-like) file(s) $outfile from +# $infile but explicitly makes the output read-only, to avoid +# inadvertent editing (who, me?). +# +# If $outfile is empty then: +# +# - If $infile is a 2-element list, it is assumed to be an in/out pair, +# and $outfile is set from the 2nd entry in that list. Else... +# +# - $outfile is set to $infile stripped of its extension. +# +# If the first argument is -touch then the generated file is touched +# to update its timestamp. This can be used as a workaround for +# cases where (A) autosetup does not update the file because it was +# not really modified and (B) the file *really* needs to be updated to +# please the build process. +# +# Failures when running chmod or touch are silently ignored. +# +proc proj-make-from-dot-in {args} { + set fIn "" + set fOut "" + set touch 0 + if {[lindex $args 0] eq "-touch"} { + set touch 1 + lassign $args - fIn fOut + } else { + lassign $args fIn fOut + } + if {"" eq $fOut} { + if {[llength $fIn]>1} { + lassign $fIn fIn fOut + } else { + set fOut [file rootname $fIn] + } + } + #puts "filenames=$filename" + if {[file exists $fOut]} { + catch { exec chmod u+w $fOut } + } + #puts "making template: $fIn ==> $fOut" + #define-push {top_srcdir} { + #puts "--- $fIn $fOut top_srcdir=[get-define top_srcdir]" + make-template $fIn $fOut + #puts "--- $fIn $fOut top_srcdir=[get-define top_srcdir]" + # make-template modifies top_srcdir + #} + if {$touch} { + proj-touch $fOut + } + catch { + exec chmod -w $fOut + #file attributes -w $f; #jimtcl has no 'attributes' + } +} + +# +# @proj-check-profile-flag ?flagname? +# +# Checks for the boolean configure option named by $flagname. If set, +# it checks if $CC seems to refer to gcc. If it does (or appears to) +# then it defines CC_PROFILE_FLAG to "-pg" and returns 1, else it +# defines CC_PROFILE_FLAG to "" and returns 0. +# +# Note that the resulting flag must be added to both CFLAGS and +# LDFLAGS in order for binaries to be able to generate "gmon.out". In +# order to avoid potential problems with escaping, space-containing +# tokens, and interfering with autosetup's use of these vars, this +# routine does not directly modify CFLAGS or LDFLAGS. +# +proc proj-check-profile-flag {{flagname profile}} { + #puts "flagname=$flagname ?[proj-opt-truthy $flagname]?" + if {[proj-opt-truthy $flagname]} { + set CC [get-define CC] + regsub {.*ccache *} $CC "" CC + # ^^^ if CC="ccache gcc" then [exec] treats "ccache gcc" as a + # single binary name and fails. So strip any leading ccache part + # for this purpose. + if { ![catch { exec $CC --version } msg]} { + if {[string first gcc $CC] != -1} { + define CC_PROFILE_FLAG "-pg" + return 1 + } + } + } + define CC_PROFILE_FLAG "" + return 0 +} + +# +# @proj-looks-like-windows ?key? +# +# Returns 1 if this appears to be a Windows environment (MinGw, +# Cygwin, MSys), else returns 0. The optional argument is the name of +# an autosetup define which contains platform name info, defaulting to +# "host" (meaning, somewhat counterintuitively, the target system, not +# the current host). The other legal value is "build" (the build +# machine, i.e. the local host). If $key == "build" then some +# additional checks may be performed which are not applicable when +# $key == "host". +# +proc proj-looks-like-windows {{key host}} { + global autosetup + switch -glob -- [get-define $key] { + *-*-ming* - *-*-cygwin - *-*-msys - *windows* { + return 1 + } + } + if {$key eq "build"} { + # These apply only to the local OS, not a cross-compilation target, + # as the above check potentially can. + if {$::autosetup(iswin)} { return 1 } + if {[find-an-executable cygpath] ne "" || $::tcl_platform(os) eq "Windows NT"} { + return 1 + } + } + return 0 +} + +# +# @proj-looks-like-mac ?key? +# +# Looks at either the 'host' (==compilation target platform) or +# 'build' (==the being-built-on platform) define value and returns if +# if that value seems to indicate that it represents a Mac platform, +# else returns 0. +# +proc proj-looks-like-mac {{key host}} { + switch -glob -- [get-define $key] { + *-*-darwin* { + # https://sqlite.org/forum/forumpost/7b218c3c9f207646 + # There's at least one Linux out there which matches *apple*. + return 1 + } + default { + return 0 + } + } +} + +# +# @proj-exe-extension +# +# Checks autosetup's "host" and "build" defines to see if the build +# host and target are Windows-esque (Cygwin, MinGW, MSys). If the +# build environment is then BUILD_EXEEXT is [define]'d to ".exe", else +# "". If the target, a.k.a. "host", is then TARGET_EXEEXT is +# [define]'d to ".exe", else "". +# +proc proj-exe-extension {} { + set rH "" + set rB "" + if {[proj-looks-like-windows host]} { + set rH ".exe" + } + if {[proj-looks-like-windows build]} { + set rB ".exe" + } + define BUILD_EXEEXT $rB + define TARGET_EXEEXT $rH +} + +# +# @proj-dll-extension +# +# Works like proj-exe-extension except that it defines BUILD_DLLEXT +# and TARGET_DLLEXT to one of (.so, ,dll, .dylib). +# +# Trivia: for .dylib files, the linker needs the -dynamiclib flag +# instead of -shared. +# +proc proj-dll-extension {} { + set inner {{key} { + if {[proj-looks-like-mac $key]} { + return ".dylib" + } + if {[proj-looks-like-windows $key]} { + return ".dll" + } + return ".so" + }} + define BUILD_DLLEXT [apply $inner build] + define TARGET_DLLEXT [apply $inner host] +} + +# +# @proj-lib-extension +# +# Static-library counterpart of proj-dll-extension. Defines +# BUILD_LIBEXT and TARGET_LIBEXT to the conventional static library +# extension for the being-built-on resp. the target platform. +# +proc proj-lib-extension {} { + set inner {{key} { + switch -glob -- [get-define $key] { + *-*-ming* - *-*-cygwin - *-*-msys { + return ".a" + # ^^^ this was ".lib" until 2025-02-07. See + # https://sqlite.org/forum/forumpost/02db2d4240 + } + default { + return ".a" + } + } + }} + define BUILD_LIBEXT [apply $inner build] + define TARGET_LIBEXT [apply $inner host] +} + +# +# @proj-file-extensions +# +# Calls all of the proj-*-extension functions. +# +proc proj-file-extensions {} { + proj-exe-extension + proj-dll-extension + proj-lib-extension +} + +# +# @proj-affirm-files-exist ?-v? filename... +# +# Expects a list of file names. If any one of them does not exist in +# the filesystem, it fails fatally with an informative message. +# Returns the last file name it checks. If the first argument is -v +# then it emits msg-checking/msg-result messages for each file. +# +proc proj-affirm-files-exist {args} { + set rc "" + set verbose 0 + if {[lindex $args 0] eq "-v"} { + set verbose 1 + set args [lrange $args 1 end] + } + foreach f $args { + if {$verbose} { msg-checking "Looking for $f ... " } + if {![file exists $f]} { + user-error "not found: $f" + } + if {$verbose} { msg-result "" } + set rc $f + } + return rc +} + +# +# @proj-check-emsdk +# +# Emscripten is used for doing in-tree builds of web-based WASM stuff, +# as opposed to WASI-based WASM or WASM binaries we import from other +# places. This is only set up for Unix-style OSes and is untested +# anywhere but Linux. Requires that the --with-emsdk flag be +# registered with autosetup. +# +# It looks for the SDK in the location specified by --with-emsdk. +# Values of "" or "auto" mean to check for the environment var EMSDK +# (which gets set by the emsdk_env.sh script from the SDK) or that +# same var passed to configure. +# +# If the given directory is found, it expects to find emsdk_env.sh in +# that directory, as well as the emcc compiler somewhere under there. +# +# If the --with-emsdk[=DIR] flag is explicitly provided and the SDK is +# not found then a fatal error is generated, otherwise failure to find +# the SDK is not fatal. +# +# Defines the following: +# +# - HAVE_EMSDK = 0 or 1 (this function's return value) +# - EMSDK_HOME = "" or top dir of the emsdk +# - EMSDK_ENV_SH = "" or $EMSDK_HOME/emsdk_env.sh +# - BIN_EMCC = "" or $EMSDK_HOME/upstream/emscripten/emcc +# +# Returns 1 if EMSDK_ENV_SH is found, else 0. If EMSDK_HOME is not empty +# but BIN_EMCC is then emcc was not found in the EMSDK_HOME, in which +# case we have to rely on the fact that sourcing $EMSDK_ENV_SH from a +# shell will add emcc to the $PATH. +# +proc proj-check-emsdk {} { + set emsdkHome [opt-val with-emsdk] + define EMSDK_HOME "" + define EMSDK_ENV_SH "" + define BIN_EMCC "" + set hadValue [llength $emsdkHome] + msg-checking "Emscripten SDK? " + if {$emsdkHome in {"" "auto"}} { + # Check the environment. $EMSDK gets set by sourcing emsdk_env.sh. + set emsdkHome [get-env EMSDK ""] + } + set rc 0 + if {$emsdkHome ne ""} { + define EMSDK_HOME $emsdkHome + set emsdkEnv "$emsdkHome/emsdk_env.sh" + if {[file exists $emsdkEnv]} { + msg-result "$emsdkHome" + define EMSDK_ENV_SH $emsdkEnv + set rc 1 + set emcc "$emsdkHome/upstream/emscripten/emcc" + if {[file exists $emcc]} { + define BIN_EMCC $emcc + } + } else { + msg-result "emsdk_env.sh not found in $emsdkHome" + } + } else { + msg-result "not found" + } + if {$hadValue && 0 == $rc} { + # Fail if it was explicitly requested but not found + proj-fatal "Cannot find the Emscripten SDK" + } + define HAVE_EMSDK $rc + return $rc +} + +# +# @proj-cc-check-Wl-flag ?flag ?args?? +# +# Checks whether the given linker flag (and optional arguments) can be +# passed from the compiler to the linker using one of these formats: +# +# - -Wl,flag[,arg1[,...argN]] +# - -Wl,flag -Wl,arg1 ...-Wl,argN +# +# If so, that flag string is returned, else an empty string is +# returned. +# +proc proj-cc-check-Wl-flag {args} { + cc-with {-link 1} { + # Try -Wl,flag,...args + set fli "-Wl" + foreach f $args { append fli ",$f" } + if {[cc-check-flags $fli]} { + return $fli + } + # Try -Wl,flag -Wl,arg1 ...-Wl,argN + set fli "" + foreach f $args { append fli "-Wl,$f " } + if {[cc-check-flags $fli]} { + return [string trim $fli] + } + return "" + } +} + +# +# @proj-check-rpath +# +# Tries various approaches to handling the -rpath link-time +# flag. Defines LDFLAGS_RPATH to that/those flag(s) or an empty +# string. Returns 1 if it finds an option, else 0. +# +# By default, the rpath is set to $prefix/lib. However, if either of +# --exec-prefix=... or --libdir=... are explicitly passed to +# configure then [get-define libdir] is used (noting that it derives +# from exec-prefix by default). +# +proc proj-check-rpath {} { + if {[proj-opt-was-provided libdir] + || [proj-opt-was-provided exec-prefix]} { + set lp "[get-define libdir]" + } else { + set lp "[get-define prefix]/lib" + } + # If we _don't_ use cc-with {} here (to avoid updating the global + # CFLAGS or LIBS or whatever it is that cc-check-flags updates) then + # downstream tests may fail because the resulting rpath gets + # implicitly injected into them. + cc-with {-link 1} { + if {[cc-check-flags "-rpath $lp"]} { + define LDFLAGS_RPATH "-rpath $lp" + } else { + set wl [proj-cc-check-Wl-flag -rpath $lp] + if {"" eq $wl} { + set wl [proj-cc-check-Wl-flag -R$lp] + } + if {"" eq $wl} { + # HP-UX: https://sqlite.org/forum/forumpost/d80ecdaddd + set wl [proj-cc-check-Wl-flag +b $lp] + } + define LDFLAGS_RPATH $wl + } + } + expr {"" ne [get-define LDFLAGS_RPATH]} +} + +# +# @proj-check-soname ?libname? +# +# Checks whether CC supports the -Wl,-soname,lib... flag. If so, it +# returns 1 and defines LDFLAGS_SONAME_PREFIX to the flag's prefix, to +# which the client would need to append "libwhatever.N". If not, it +# returns 0 and defines LDFLAGS_SONAME_PREFIX to an empty string. +# +# The libname argument is only for purposes of running the flag +# compatibility test, and is not included in the resulting +# LDFLAGS_SONAME_PREFIX. It is provided so that clients may +# potentially avoid some end-user confusion by using their own lib's +# name here (which shows up in the "checking..." output). +# +proc proj-check-soname {{libname "libfoo.so.0"}} { + cc-with {-link 1} { + if {[cc-check-flags "-Wl,-soname,${libname}"]} { + define LDFLAGS_SONAME_PREFIX "-Wl,-soname," + return 1 + } elseif {[cc-check-flags "-Wl,+h,${libname}"]} { + # HP-UX: https://sqlite.org/forum/forumpost/d80ecdaddd + define LDFLAGS_SONAME_PREFIX "-Wl,+h," + return 1 + } else { + define LDFLAGS_SONAME_PREFIX "" + return 0 + } + } +} + +# +# @proj-check-fsanitize ?list-of-opts? +# +# Checks whether CC supports -fsanitize=X, where X is each entry of +# the given list of flags. If any of those flags are supported, it +# returns the string "-fsanitize=X..." where X... is a comma-separated +# list of all flags from the original set which are supported. If none +# of the given options are supported then it returns an empty string. +# +# Example: +# +# set f [proj-check-fsanitize {address bounds-check just-testing}] +# +# Will, on many systems, resolve to "-fsanitize=address,bounds-check", +# but may also resolve to "-fsanitize=address". +# +proc proj-check-fsanitize {{opts {address bounds-strict}}} { + set sup {} + foreach opt $opts { + # -nooutput is used because -fsanitize=hwaddress will otherwise + # pass this test on x86_64, but then warn at build time that + # "hwaddress is not supported for this target". + cc-with {-nooutput 1} { + if {[cc-check-flags "-fsanitize=$opt"]} { + lappend sup $opt + } + } + } + if {[llength $sup] > 0} { + return "-fsanitize=[join $sup ,]" + } + return "" +} + +# +# Internal helper for proj-dump-defs-json. Expects to be passed a +# [define] name and the variadic $args which are passed to +# proj-dump-defs-json. 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 proj-defs-type_ {name spec} { + foreach {type patterns} $spec { + foreach pattern $patterns { + if {[string match $pattern $name]} { + return $type + } + } + } + return "" +} + +# +# Internal helper for proj-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 proj-quote-str_ {value} { + return \"[string map [list \\ \\\\ \" \\\"] $value]\" +} + +# +# An internal impl detail of proj-dump-defs-json. Requires a data +# type specifier, as used by make-config-header, and a value. Returns +# the formatted value or the value $::proj__Config(defs-skip) if the caller +# should skip emitting that value. +# +set ::proj__Config(defs-skip) "-proj-defs-format_ sentinel" +proc proj-defs-format_ {type value} { + switch -exact -- $type { + -bare { + # Just output the value unchanged + } + -none { + set value $::proj__Config(defs-skip) + } + -str { + set value [proj-quote-str_ $value] + } + -auto { + # Automatically determine the type + if {![string is integer -strict $value]} { + set value [proj-quote-str_ $value] + } + } + -array { + set ar {} + foreach v $value { + set v [proj-defs-format_ -auto $v] + if {$::proj__Config(defs-skip) ne $v} { + lappend ar $v + } + } + set value "\[ [join $ar {, }] \]" + } + "" { + set value $::proj__Config(defs-skip) + } + default { + proj-fatal "Unknown type in proj-dump-defs-json: $type" + } + } + return $value +} + +# +# @proj-dump-defs-json outfile ...flags +# +# This function works almost identically to autosetup's +# make-config-header but emits its output in JSON form. It is not a +# fully-functional JSON emitter, and will emit broken JSON for +# complicated outputs, but should be sufficient for purposes of +# emitting most configure vars (numbers and simple strings). +# +# In addition to the formatting flags supported by make-config-header, +# it also supports: +# +# -array {patterns...} +# +# Any defines matching the given patterns will be treated as a list of +# values, each of which will be formatted as if it were in an -auto {...} +# set, and the define will be emitted to JSON in the form: +# +# "ITS_NAME": [ "value1", ...valueN ] +# +# Achtung: if a given -array pattern contains values which themselves +# contains spaces... +# +# define-append foo {"-DFOO=bar baz" -DBAR="baz barre"} +# +# will lead to: +# +# ["-DFOO=bar baz", "-DBAR=\"baz", "barre\""] +# +# Neither is especially satisfactory (and the second is useless), and +# handling of such values is subject to change if any such values ever +# _really_ need to be processed by our source trees. +# +proc proj-dump-defs-json {file args} { + file mkdir [file dirname $file] + set lines {} + lappend args -bare {SIZEOF_* HAVE_DECL_*} -auto HAVE_* + foreach n [lsort [dict keys [all-defines]]] { + set type [proj-defs-type_ $n $args] + set value [proj-defs-format_ $type [get-define $n]] + if {$::proj__Config(defs-skip) ne $value} { + lappend lines "\"$n\": ${value}" + } + } + set buf {} + lappend buf [join $lines ",\n"] + write-if-changed $file $buf { + msg-result "Created $file" + } +} + +# +# @proj-xfer-option-aliases map +# +# Expects a list of pairs of configure flags which have been +# registered with autosetup, in this form: +# +# { alias1 => canonical1 +# aliasN => canonicalN ... } +# +# The names must not have their leading -- part and must be in the +# form which autosetup will expect for passing to [opt-val NAME] and +# friends. +# +# Comment lines are permitted in the input. +# +# For each pair of ALIAS and CANONICAL, if --ALIAS is provided but +# --CANONICAL is not, the value of the former is copied to the +# latter. If --ALIAS is not provided, this is a no-op. If both have +# explicitly been provided a fatal usage error is triggered. +# +# Motivation: autosetup enables "hidden aliases" in [options] lists, +# and elides the aliases from --help output but does no further +# handling of them. For example, when --alias is a hidden alias of +# --canonical and a user passes --alias=X, [opt-val canonical] returns +# no value. i.e. the script must check both [opt-val alias] and +# [opt-val canonical]. The intent here is that this function be +# passed such mappings immediately after [options] is called, to carry +# over any values from hidden aliases into their canonical names, such +# that [opt-value canonical] will return X if --alias=X is passed to +# configure. +# +# That said: autosetup's [opt-str] does support alias forms, but it +# requires that the caller know all possible aliases. It's simpler, in +# terms of options handling, if there's only a single canonical name +# which each down-stream call of [opt-...] has to know. +# +proc proj-xfer-options-aliases {mapping} { + foreach {hidden - canonical} [proj-strip-hash-comments $mapping] { + if {[proj-opt-was-provided $hidden]} { + if {[proj-opt-was-provided $canonical]} { + proj-fatal "both --$canonical and its alias --$hidden were used. Use only one or the other." + } else { + proj-opt-set $canonical [opt-val $hidden] + } + } + } +} + +# +# Arguable/debatable... +# +# When _not_ cross-compiling and CC_FOR_BUILD is _not_ explicitly +# specified, force CC_FOR_BUILD to be the same as CC, so that: +# +# ./configure CC=clang +# +# will use CC_FOR_BUILD=clang, instead of cc, for building in-tree +# tools. This is based off of an email discussion and is thought to +# be likely to cause less confusion than seeing 'cc' invocations +# when when the user passes CC=clang. +# +# Sidebar: if we do this before the cc package is installed, it gets +# reverted by that package. Ergo, the cc package init will tell the +# user "Build C compiler...cc" shortly before we tell them otherwise. +# +proc proj-redefine-cc-for-build {} { + if {![proj-is-cross-compiling] + && [get-define CC] ne [get-define CC_FOR_BUILD] + && "nope" eq [get-env CC_FOR_BUILD "nope"]} { + user-notice "Re-defining CC_FOR_BUILD to CC=[get-define CC]. To avoid this, explicitly pass CC_FOR_BUILD=..." + define CC_FOR_BUILD [get-define CC] + } +} + +# +# @proj-which-linenoise headerFile +# +# Attempts to determine whether the given linenoise header file is of +# the "antirez" or "msteveb" flavor. It returns 2 for msteveb, else 1 +# (it does not validate that the header otherwise contains the +# linenoise API). +# +proc proj-which-linenoise {dotH} { + set srcHeader [proj-file-content $dotH] + if {[string match *userdata* $srcHeader]} { + return 2 + } else { + return 1 + } +} + +# +# @proj-remap-autoconf-dir-vars +# +# "Re-map" the autoconf-conventional --XYZdir flags into something +# which is more easily overridable from a make invocation. +# +# Based off of notes in <https://sqlite.org/forum/forumpost/00d12a41f7>. +# +# Consider: +# +# $ ./configure --prefix=/foo +# $ make install prefix=/blah +# +# In that make invocation, $(libdir) would, at make-time, normally be +# hard-coded to /foo/lib, rather than /blah/lib. That happens because +# autosetup exports conventional $prefix-based values for the numerous +# autoconfig-compatible XYZdir vars at configure-time. What we would +# normally want, however, is that --libdir derives from the make-time +# $(prefix). The distinction between configure-time and make-time is +# the significant factor there. +# +# This function attempts to reconcile those vars in such a way that +# they will derive, at make-time, from $(prefix) in a conventional +# manner unless they are explicitly overridden at configure-time, in +# which case those overrides takes precedence. +# +# Each autoconf-relvant --XYZ flag which is explicitly passed to +# configure is exported as-is, as are those which default to some +# top-level system directory, e.g. /etc or /var. All which derive +# from either $prefix or $exec_prefix are exported in the form of a +# Makefile var reference, e.g. libdir=${exec_prefix}/lib. Ergo, if +# --exec-prefix=FOO is passed to configure, libdir will still derive, +# at make-time, from whatever exec_prefix is passed to make, and will +# use FOO if exec_prefix is not overridden at make-time. Without this +# post-processing, libdir would be cemented in as FOO/lib at +# configure-time, so could be tedious to override properly via a make +# invocation. +# +proc proj-remap-autoconf-dir-vars {} { + set prefix [get-define prefix] + set exec_prefix [get-define exec_prefix $prefix] + # The following var derefs must be formulated such that they are + # legal for use in (A) makefiles, (B) pkgconfig files, and (C) TCL's + # [subst] command. i.e. they must use the form ${X}. + foreach {flag makeVar makeDeref} { + exec-prefix exec_prefix ${prefix} + datadir datadir ${prefix}/share + mandir mandir ${datadir}/man + includedir includedir ${prefix}/include + bindir bindir ${exec_prefix}/bin + libdir libdir ${exec_prefix}/lib + sbindir sbindir ${exec_prefix}/sbin + sysconfdir sysconfdir /etc + sharedstatedir sharedstatedir ${prefix}/com + localstatedir localstatedir /var + runstatedir runstatedir /run + infodir infodir ${datadir}/info + libexecdir libexecdir ${exec_prefix}/libexec + } { + if {[proj-opt-was-provided $flag]} { + define $makeVar [join [opt-val $flag]] + } else { + define $makeVar [join $makeDeref] + } + # Maintenance reminder: the [join] call is to avoid {braces} + # around the output when someone passes in, + # e.g. --libdir=\${prefix}/foo/bar. Debian's SQLite package build + # script does that. + } +} + +# +# @proj-env-file flag ?default? +# +# If a file named .env-$flag exists, this function returns a +# trimmed copy of its contents, else it returns $dflt. The intended +# usage is that things like developer-specific CFLAGS preferences can +# be stored in .env-CFLAGS. +# +proc proj-env-file {flag {dflt ""}} { + set fn ".env-${flag}" + if {[file readable $fn]} { + return [proj-file-content -trim $fn] + } + return $dflt +} + +# +# @proj-get-env var ?default? +# +# Extracts the value of "environment" variable $var from the first of +# the following places where it's defined: +# +# - Passed to configure as $var=... +# - Exists as an environment variable +# - A file named .env-$var (see [proj-env-file]) +# +# If none of those are set, $dflt is returned. +# +proc proj-get-env {var {dflt ""}} { + get-env $var [proj-env-file $var $dflt] +} + +# +# @proj-scope ?lvl? +# +# Returns the name of the _calling_ proc from ($lvl + 1) levels up the +# call stack (where the caller's level will be 1 up from _this_ +# call). If $lvl would resolve to global scope "global scope" is +# returned and if it would be negative then a string indicating such +# is returned (as opposed to throwing an error). +# +proc proj-scope {{lvl 0}} { + #uplevel [expr {$lvl + 1}] {lindex [info level 0] 0} + set ilvl [info level] + set offset [expr {$ilvl - $lvl - 1}] + if { $offset < 0} { + return "invalid scope ($offset)" + } elseif { $offset == 0} { + return "global scope" + } else { + return [lindex [info level $offset] 0] + } +} + +# +# Deprecated name of [proj-scope]. +# +proc proj-current-scope {{lvl 0}} { + puts stderr \ + "Deprecated proj-current-scope called from [proj-scope 1]. Use proj-scope instead." + proj-scope [incr lvl] +} + +# +# Converts parts of tclConfig.sh to autosetup [define]s. +# +# Expects to be passed the name of a value tclConfig.sh or an empty +# string. It converts certain parts of that file's contents to +# [define]s (see the code for the whole list). If $tclConfigSh is an +# empty string then it [define]s the various vars as empty strings. +# +proc proj-tclConfig-sh-to-autosetup {tclConfigSh} { + set shBody {} + set tclVars { + TCL_INCLUDE_SPEC + TCL_LIBS + TCL_LIB_SPEC + TCL_STUB_LIB_SPEC + TCL_EXEC_PREFIX + TCL_PREFIX + TCL_VERSION + TCL_MAJOR_VERSION + TCL_MINOR_VERSION + TCL_PACKAGE_PATH + TCL_PATCH_LEVEL + TCL_SHLIB_SUFFIX + } + # Build a small shell script which proxies the $tclVars from + # $tclConfigSh into autosetup code... + lappend shBody "if test x = \"x${tclConfigSh}\"; then" + foreach v $tclVars { + lappend shBody "$v= ;" + } + lappend shBody "else . \"${tclConfigSh}\"; fi" + foreach v $tclVars { + lappend shBody "echo define $v {\$$v} ;" + } + lappend shBody "exit" + set shBody [join $shBody "\n"] + #puts "shBody=$shBody\n"; exit + eval [exec echo $shBody | sh] +} + +# +# @proj-tweak-default-env-dirs +# +# This function is not useful before [use system] is called to set up +# --prefix and friends. It should be called as soon after [use system] +# as feasible. +# +# For certain target environments, if --prefix is _not_ passed in by +# the user, set the prefix to an environment-specific default. For +# such environments its does [define prefix ...] and [proj-opt-set +# prefix ...], but it does not process vars derived from the prefix, +# e.g. exec-prefix. To do so it is generally necessary to also call +# proj-remap-autoconf-dir-vars late in the config process (immediately +# before ".in" files are filtered). +# +# Similar modifications may be made for --mandir. +# +# Returns >0 if it modifies the environment, else 0. +# +proc proj-tweak-default-env-dirs {} { + set rc 0 + switch -glob -- [get-define host] { + *-haiku { + if {![proj-opt-was-provided prefix]} { + set hdir /boot/home/config/non-packaged + proj-opt-set prefix $hdir + define prefix $hdir + incr rc + } + if {![proj-opt-was-provided mandir]} { + set hdir /boot/system/documentation/man + proj-opt-set mandir $hdir + define mandir $hdir + incr rc + } + } + } + return $rc +} + +# +# @proj-dot-ins-append file ?fileOut ?postProcessScript?? +# +# Queues up an autosetup [make-template]-style file to be processed +# at a later time using [proj-dot-ins-process]. +# +# $file is the input file. If $fileOut is empty then this function +# derives $fileOut from $file, stripping both its directory and +# extension parts. i.e. it defaults to writing the output to the +# current directory (typically $::autosetup(builddir)). +# +# If $postProcessScript is not empty then, during +# [proj-dot-ins-process], it will be eval'd immediately after +# processing the file. In the context of that script, the vars +# $dotInsIn and $dotInsOut will be set to the input and output file +# names. This can be used, for example, to make the output file +# executable or perform validation on its contents: +# +## proj-dot-ins-append my.sh.in my.sh { +## catch {exec chmod u+x $dotInsOut} +## } +# +# See [proj-dot-ins-process], [proj-dot-ins-list] +# +proc proj-dot-ins-append {fileIn args} { + set srcdir $::autosetup(srcdir) + switch -exact -- [llength $args] { + 0 { + lappend fileIn [file rootname [file tail $fileIn]] "" + } + 1 { + lappend fileIn [join $args] "" + } + 2 { + lappend fileIn {*}$args + } + default { + proj-fatal "Too many arguments: $fileIn $args" + } + } + #puts "******* [proj-scope]: adding [llength $fileIn]-length item: $fileIn" + lappend ::proj__Config(dot-in-files) $fileIn +} + +# +# @proj-dot-ins-list +# +# Returns the current list of [proj-dot-ins-append]'d files, noting +# that each entry is a 3-element list of (inputFileName, +# outputFileName, postProcessScript). +# +proc proj-dot-ins-list {} { + return $::proj__Config(dot-in-files) +} + +# +# @proj-dot-ins-process ?-touch? ?-validate? ?-clear? +# +# Each file which has previously been passed to [proj-dot-ins-append] +# is processed, with its passing its in-file out-file names to +# [proj-make-from-dot-in]. +# +# The intent is that a project accumulate any number of files to +# filter and delay their actual filtering until the last stage of the +# configure script, calling this function at that time. +# +# Optional flags: +# +# -touch: gets passed on to [proj-make-from-dot-in] +# +# -validate: after processing each file, before running the file's +# associated script, if any, it runs the file through +# proj-validate-no-unresolved-ats, erroring out if that does. +# +# -clear: after processing, empty the dot-ins list. This effectively +# makes proj-dot-ins-append available for re-use. +# +proc proj-dot-ins-process {args} { + 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. Got: $f" + lassign $f fIn fOut fScript + #puts "DOING $fIn ==> $fOut" + proj-make-from-dot-in {*}$flags(-touch) $fIn $fOut + if {$flags(-validate)} { + proj-validate-no-unresolved-ats $fOut + } + if {"" ne $fScript} { + uplevel 1 [join [list set dotInsIn $fIn \; \ + set dotInsOut $fOut \; \ + eval \{${fScript}\} \; \ + unset dotInsIn dotInsOut]] + } + } + if {$flags(-clear)} { + set ::proj__Config(dot-in-files) [list] + } +} + +# +# @proj-validate-no-unresolved-ats filenames... +# +# For each filename given to it, it validates that the file has no +# unresolved @VAR@ references. If it finds any, it produces an error +# with location information. +# +# Exception: if a filename matches the pattern {*[Mm]ake*} AND a given +# line begins with a # (not including leading whitespace) then that +# line is ignored for purposes of this validation. The intent is that +# @VAR@ inside of makefile comments should not (necessarily) cause +# validation to fail, as it's sometimes convenient to comment out +# sections during development of a configure script and its +# corresponding makefile(s). +# +proc proj-validate-no-unresolved-ats {args} { + foreach f $args { + set lnno 1 + 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]} { + error "Unresolved reference to $match at line $lnno of $f" + } + } + incr lnno + } + } +} + +# +# @proj-first-file-found tgtVar fileList +# +# Searches $fileList for an existing file. If one is found, its name +# is assigned to tgtVar and 1 is returned, else tgtVar is set to "" +# and 0 is returned. +# +proc proj-first-file-found {tgtVar fileList} { + upvar $tgtVar tgt + foreach f $fileList { + if {[file exists $f]} { + set tgt $f + return 1 + } + } + set tgt "" + return 0 +} + +# +# Defines $defName to contain makefile recipe commands for re-running +# the configure script with its current set of $::argv flags. This +# can be used to automatically reconfigure. +# +proc proj-setup-autoreconfig {defName} { + define $defName \ + [join [list \ + cd \"$::autosetup(builddir)\" \ + && [get-define AUTOREMAKE "error - missing @AUTOREMAKE@"]]] +} + +# +# @prop-append-to defineName args... +# +# A proxy for Autosetup's [define-append]. Appends all non-empty $args +# to [define-append $defineName]. +# +proc proj-define-append {defineName args} { + foreach a $args { + if {"" ne $a} { + define-append $defineName {*}$a + } + } +} + +# +# @prod-define-amend ?-p|-prepend? ?-d|-define? defineName args... +# +# A proxy for Autosetup's [define-append]. +# +# Appends all non-empty $args to the define named by $defineName. If +# one of (-p | -prepend) are used it instead prepends them, in their +# given order, to $defineName. +# +# If -define is used then each argument is assumed to be a [define]'d +# flag and [get-define X ""] is used to fetch it. +# +# Re. linker flags: typically, -lXYZ flags need to be in "reverse" +# order, with each -lY resolving symbols for -lX's to its left. This +# order is largely historical, and not relevant on all environments, +# but it is technically correct and still relevant on some +# environments. +# +# See: proj-append-to +# +proc proj-define-amend {args} { + set defName "" + set prepend 0 + set isdefs 0 + set xargs [list] + foreach arg $args { + switch -exact -- $arg { + "" {} + -p - -prepend { incr prepend } + -d - -define { incr isdefs } + default { + if {"" eq $defName} { + set defName $arg + } else { + lappend xargs $arg + } + } + } + } + if {"" eq $defName} { + proj-error "Missing defineName argument in call from [proj-scope 1]" + } + if {$isdefs} { + set args $xargs + set xargs [list] + foreach arg $args { + lappend xargs [get-define $arg ""] + } + set args $xargs + } +# puts "**** args=$args" +# puts "**** xargs=$xargs" + + set args $xargs + if {$prepend} { + lappend args {*}[get-define $defName ""] + define $defName [join $args]; # join to eliminate {} entries + } else { + proj-define-append $defName {*}$args + } +} + +# +# @proj-define-to-cflag ?-list? ?-quote? ?-zero-undef? defineName... +# +# Treat each argument as the name of a [define] and renders it like a +# CFLAGS value in one of the following forms: +# +# -D$name +# -D$name=integer (strict integer matches only) +# '-D$name=value' (without -quote) +# '-D$name="value"' (with -quote) +# +# It treats integers as numbers and everything else as a quoted +# string, noting that it does not handle strings which themselves +# contain quotes. +# +# The -zero-undef flag causes no -D to be emitted for integer values +# of 0. +# +# By default it returns the result as string of all -D... flags, +# but if passed the -list flag it will return a list of the +# individual CFLAGS. +# +proc proj-define-to-cflag {args} { + set rv {} + proj-parse-flags args flags { + -list 0 {expr 1} + -quote 0 {expr 1} + -zero-undef 0 {expr 1} + } + foreach d $args { + set v [get-define $d ""] + set li {} + if {"" eq $d} { + set v "-D${d}" + } elseif {[string is integer -strict $v]} { + if {!$flags(-zero-undef) || $v ne "0"} { + set v "-D${d}=$v" + } + } elseif {$flags(-quote)} { + set v "'-D${d}=\"$v\"'" + } else { + set v "'-D${d}=$v'" + } + lappend rv $v + } + expr {$flags(-list) ? $rv : [join $rv]} +} + + +if {0} { + # Turns out that autosetup's [options-add] essentially does exactly + # this... + + # A list of lists of Autosetup [options]-format --flags definitions. + # Append to this using [proj-options-add] and use + # [proj-options-combine] to merge them into a single list for passing + # to [options]. + # + set ::proj__Config(extra-options) {} + + # @proj-options-add list + # + # Adds a list of options to the pending --flag processing. It must be + # in the format used by Autosetup's [options] function. + # + # This will have no useful effect if called from after [options] + # is called. + # + # Use [proj-options-combine] to get a combined list of all added + # options. + # + # PS: when writing this i wasn't aware of autosetup's [options-add], + # works quite similarly. Only the timing is different. + proc proj-options-add {list} { + lappend ::proj__Config(extra-options) $list + } + + # @proj-options-combine list1 ?...listN? + # + # Expects each argument to be a list of options compatible with + # autosetup's [options] function. This function concatenates the + # contents of each list into a new top-level list, stripping the outer + # list part of each argument, and returning that list + # + # If passed no arguments, it uses the list generated by calls to + # [proj-options-add]. + proc proj-options-combine {args} { + set rv [list] + if {0 == [llength $args]} { + set args $::proj__Config(extra-options) + } + foreach e $args { + lappend rv {*}$e + } + return $rv + } +}; # proj-options-* + +# Internal cache for use via proj-cache-*. +array set proj__Cache {} + +# +# @proj-cache-key arg {addLevel 0} +# +# Helper to generate cache keys for [proj-cache-*]. +# +# $addLevel should almost always be 0. +# +# 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-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. +# +# Anything else: returned as-is +# +proc proj-cache-key {arg {addLevel 0}} { + if {[string is integer -strict $arg]} { + return [proj-scope [expr {$arg + $addLevel + 1}]] + } + return $arg +} + +# +# @proj-cache-set ?-key KEY? ?-level 0? value +# +# Sets a feature-check cache entry with the given key. +# +# 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-flags args flags { + -key => 0 + -level => 0 + } + lassign $args val + set key [proj-cache-key $flags(-key) [expr {1 + $flags(-level)}]] + #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 $key [expr {1 + $addLevel}]] + set rv "" + if {[info exists ::proj__Cache($key)]} { + set rv $::proj__Cache($key) + unset ::proj__Cache($key) + } + return $rv; +} + +# +# @proj-cache-check ?-key KEY? ?-level LEVEL? 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 {args} { + proj-parse-flags args flags { + -key => 0 + -level => 0 + } + lassign $args tgtVar + upvar $tgtVar tgt + set rc 0 + set key [proj-cache-key $flags(-key) [expr {1 + $flags(-level)}]] + #puts "** fcheck get key=$key" + if {[info exists ::proj__Cache($key)]} { + set tgt $::proj__Cache($key) + incr rc + } else { + set tgt "" + } + return $rc +} + +# +# @proj-coalesce ...args +# +# Returns the first argument which is not empty (eq ""), or an empty +# string on no match. +proc proj-coalesce {args} { + foreach arg $args { + if {"" ne $arg} { + return $arg + } + } + return "" +} + +# +# @proj-parse-flags argvListName targetArrayName {prototype} +# +# A helper to parse flags from proc argument lists. +# +# The first argument is the name of a var holding the args to +# parse. It will be overwritten, possibly with a smaller list. +# +# The second argument is the name of an array variable to create in +# the caller's scope. +# +# 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 ?-literal|-call|-apply? +# script|number|incr|proc-name|{apply $aLambda} +# +# -flag* ...as above... +# +# -flag => defaultValue ?-call proc-name-and-args|-apply lambdaExpr? +# +# -flag* => ...as above... +# +# :PRAGMA +# +# 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. +# +# If $argv contains any given flag from $prototype, its default value +# is overridden depending on several factors: +# +# - 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. +# +# - 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 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, not counting +# "--". +# +# Example: +# +## 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 1 -z 2} +# and $args would be {8 9 10 -theEnd}. +# +# Pragmas: +# +# 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 outFlags + array set flags {}; # staging area + array set blob {}; # holds markers for various per-key state and options + set incrSkip 1; # 1 if we stop at the first non-flag, else 0 + # Parse $prototype for flag definitions... + set n [llength $prototype] + set checkProtoFlag { + #puts "**** checkProtoFlag #$i of $n k=$k fv=$fv" + switch -exact -- $fv { + -literal { + proj-assert {![info exists blob(${k}.consumes)]} + set blob(${k}.script) [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 blob(${k}.call) "apply $fv" + } + -call { + # arg is either a proc name or {apply $aLambda} + set fv [lindex $prototype [incr i]] + lappend blob(${k}.call) $fv + } + default { + proj-assert {![info exists blob(${k}.consumes)]} + set blob(${k}.script) $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 argument: $k" + + if {[string match {*\*} $k]} { + # Re-map -foo* to -foo and flag -foo as a repeatable flag + set k [string map {* ""} $k] + incr blob(${k}.multi) + } + + 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 -up "[proj-scope]: Missing argument for $k => flag" + } + incr blob(${k}.consumes) + 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 + } + } + } + default { + # -flag VALUE ?flag? SCRIPT + set vi [lindex $prototype [incr i]] + set fv [lindex $prototype [incr i]] + eval $checkProtoFlag + } + } + #puts "**** #$i of $n k=$k vi=$vi" + set flags($k) $vi + } + #puts "-- flags"; parray flags + #puts "-- blob"; parray blob + set rc 0 + set rv {}; # staging area for the target argv value + 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} { + # "--" is the conventional way to end processing of args + if {[incr blob(--)] > 1} { + # Elide only the first one + lappend rv $arg + } + incr skipMode $incrSkip + } elseif {[info exists flags($arg)]} { + # A known flag... + set isMulti [info exists blob(${arg}.multi)] + incr blob(${arg}.seen) + if {1 < $blob(${arg}.seen) && !$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 blob(${arg}.consumes)] + 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 blob(${arg}.script)]} { + set vMode 1 + set vv $blob(${arg}.script) + } else { + set vv $flags($arg) + } + + if {[info exists blob(${arg}.call)]} { + set vMode 2 + set vv [concat {*}$blob(${arg}.call) $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" + } + } + } else { + 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 == $blob(${arg}.seen)} { + # On the first hit, overwrite the default with a new list. + set flags($arg) [list $vv] + } else { + # On subsequent hits, append to the list. + lappend flags($arg) $vv + } + } else { + set flags($arg) $vv + } + incr rc + } else { + # 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 {"here" eq [proj-cache-key here]} + proj-assert {"" eq $check} + proj-cache-set -key here thevalue + proj-assert {[proj-cache-check -key here check]} + proj-assert {"thevalue" eq $check} + + proj-assert {![proj-cache-check check]} + #puts "*** key = ([proj-cache-key 0])" + 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 {![proj-cache-check 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