Home | History | Annotate | Line # | Download | only in autosetup
      1  1.1  christos ########################################################################
      2  1.1  christos # 2024 September 25
      3  1.1  christos #
      4  1.1  christos # The author disclaims copyright to this source code.  In place of
      5  1.1  christos # a legal notice, here is a blessing:
      6  1.1  christos #
      7  1.1  christos #  * May you do good and not evil.
      8  1.1  christos #  * May you find forgiveness for yourself and forgive others.
      9  1.1  christos #  * May you share freely, never taking more than you give.
     10  1.1  christos #
     11  1.1  christos 
     12  1.1  christos #
     13  1.1  christos # ----- @module proj.tcl -----
     14  1.1  christos # @section Project-agnostic Helper APIs
     15  1.1  christos #
     16  1.1  christos 
     17  1.1  christos #
     18  1.1  christos # Routines for Steve Bennett's autosetup which are common to trees
     19  1.1  christos # managed in and around the umbrella of the SQLite project.
     20  1.1  christos #
     21  1.1  christos # The intent is that these routines be relatively generic, independent
     22  1.1  christos # of a given project.
     23  1.1  christos #
     24  1.1  christos # For practical purposes, the copy of this file hosted in the SQLite
     25  1.1  christos # project is the "canonical" one:
     26  1.1  christos #
     27  1.1  christos # https://sqlite.org/src/file/autosetup/proj.tcl
     28  1.1  christos #
     29  1.1  christos # This file was initially derived from one used in the libfossil
     30  1.1  christos # project, authored by the same person who ported it here, and this is
     31  1.1  christos # noted here only as an indication that there are no licensing issues
     32  1.1  christos # despite this code having a handful of near-twins running around a
     33  1.1  christos # handful of third-party source trees.
     34  1.1  christos #
     35  1.1  christos # Design notes:
     36  1.1  christos #
     37  1.1  christos # - Symbols with _ separators are intended for internal use within
     38  1.1  christos #   this file, and are not part of the API which auto.def files should
     39  1.1  christos #   rely on. Symbols with - separators are public APIs.
     40  1.1  christos #
     41  1.1  christos # - By and large, autosetup prefers to update global state with the
     42  1.1  christos #   results of feature checks, e.g. whether the compiler supports flag
     43  1.1  christos #   --X.  In this developer's opinion that (A) causes more confusion
     44  1.1  christos #   than it solves[^1] and (B) adds an unnecessary layer of "voodoo"
     45  1.1  christos #   between the autosetup user and its internals. This module, in
     46  1.1  christos #   contrast, instead injects the results of its own tests into
     47  1.1  christos #   well-defined variables and leaves the integration of those values
     48  1.1  christos #   to the caller's discretion.
     49  1.1  christos #
     50  1.1  christos # [1]: As an example: testing for the -rpath flag, using
     51  1.1  christos # cc-check-flags, can break later checks which use
     52  1.1  christos # [cc-check-function-in-lib ...] because the resulting -rpath flag
     53  1.1  christos # implicitly becomes part of those tests. In the case of an rpath
     54  1.1  christos # test, downstream tests may not like the $prefix/lib path added by
     55  1.1  christos # the rpath test. To avoid such problems, we avoid (intentionally)
     56  1.1  christos # updating global state via feature tests.
     57  1.1  christos #
     58  1.1  christos 
     59  1.1  christos #
     60  1.1  christos # $proj__Config is an internal-use-only array for storing whatever generic
     61  1.1  christos # internal stuff we need stored.
     62  1.1  christos #
     63  1.1  christos array set ::proj__Config [subst {
     64  1.1  christos   self-tests [get-env proj.self-tests 0]
     65  1.1  christos   verbose-assert [get-env proj.assert-verbose 0]
     66  1.1  christos   isatty [isatty? stdout]
     67  1.1  christos }]
     68  1.1  christos 
     69  1.1  christos #
     70  1.1  christos # List of dot-in files to filter in the final stages of
     71  1.1  christos # configuration. Some configuration steps may append to this.  Each
     72  1.1  christos # one in this list which exists will trigger the generation of a
     73  1.1  christos # file with that same name, minus the ".in", in the build directory
     74  1.1  christos # (which differ from the source dir in out-of-tree builds).
     75  1.1  christos #
     76  1.1  christos # See: proj-dot-ins-append and proj-dot-ins-process
     77  1.1  christos #
     78  1.1  christos set ::proj__Config(dot-in-files) [list]
     79  1.1  christos 
     80  1.1  christos #
     81  1.1  christos # @proj-warn msg
     82  1.1  christos #
     83  1.1  christos # Emits a warning message to stderr. All args are appended with a
     84  1.1  christos # space between each.
     85  1.1  christos #
     86  1.1  christos proc proj-warn {args} {
     87  1.1  christos   show-notices
     88  1.1  christos   puts stderr [join [list "WARNING:" \[ [proj-scope 1] \]: {*}$args] " "]
     89  1.1  christos }
     90  1.1  christos 
     91  1.1  christos 
     92  1.1  christos #
     93  1.1  christos # Internal impl of [proj-fatal] and [proj-error]. It must be called
     94  1.1  christos # using tailcall.
     95  1.1  christos #
     96  1.1  christos proc proj__faterr {failMode args} {
     97  1.1  christos   show-notices
     98  1.1  christos   set lvl 1
     99  1.1  christos   while {"-up" eq [lindex $args 0]} {
    100  1.1  christos     set args [lassign $args -]
    101  1.1  christos     incr lvl
    102  1.1  christos   }
    103  1.1  christos   if {$failMode} {
    104  1.1  christos     puts stderr [join [list "FATAL:" \[ [proj-scope $lvl] \]: {*}$args]]
    105  1.1  christos     exit 1
    106  1.1  christos   } else {
    107  1.1  christos     error [join [list in \[ [proj-scope $lvl] \]: {*}$args]]
    108  1.1  christos   }
    109  1.1  christos }
    110  1.1  christos 
    111  1.1  christos #
    112  1.1  christos # @proj-fatal ?-up...? msg...
    113  1.1  christos #
    114  1.1  christos # Emits an error message to stderr and exits with non-0. All args are
    115  1.1  christos # appended with a space between each.
    116  1.1  christos #
    117  1.1  christos # The calling scope's name is used in the error message. To instead
    118  1.1  christos # use the name of a call higher up in the stack, use -up once for each
    119  1.1  christos # additional level.
    120  1.1  christos #
    121  1.1  christos proc proj-fatal {args} {
    122  1.1  christos   tailcall proj__faterr 1 {*}$args
    123  1.1  christos }
    124  1.1  christos 
    125  1.1  christos #
    126  1.1  christos # @proj-error ?-up...? msg...
    127  1.1  christos #
    128  1.1  christos # Works like proj-fatal but uses [error] intead of [exit].
    129  1.1  christos #
    130  1.1  christos proc proj-error {args} {
    131  1.1  christos   tailcall proj__faterr 0 {*}$args
    132  1.1  christos }
    133  1.1  christos 
    134  1.1  christos #
    135  1.1  christos # @proj-assert script ?message?
    136  1.1  christos #
    137  1.1  christos # Kind of like a C assert: if uplevel of [list expr $script] is false,
    138  1.1  christos # a fatal error is triggered. The error message, by default, includes
    139  1.1  christos # the body of the failed assertion, but if $msg is set then that is
    140  1.1  christos # used instead.
    141  1.1  christos #
    142  1.1  christos proc proj-assert {script {msg ""}} {
    143  1.1  christos   if {1 eq $::proj__Config(verbose-assert)} {
    144  1.1  christos     msg-result [proj-bold "asserting: $script"]
    145  1.1  christos   }
    146  1.1  christos   if {![uplevel 1 [list expr $script]]} {
    147  1.1  christos     if {"" eq $msg} {
    148  1.1  christos       set msg $script
    149  1.1  christos     }
    150  1.1  christos     tailcall proj__faterr 1 "Assertion failed:" $msg
    151  1.1  christos   }
    152  1.1  christos }
    153  1.1  christos 
    154  1.1  christos #
    155  1.1  christos # @proj-bold str
    156  1.1  christos #
    157  1.1  christos # If this function believes that the current console might support
    158  1.1  christos # ANSI escape sequences then this returns $str wrapped in a sequence
    159  1.1  christos # to bold that text, else it returns $str as-is.
    160  1.1  christos #
    161  1.1  christos proc proj-bold {args} {
    162  1.1  christos   if {$::autosetup(iswin) || !$::proj__Config(isatty)} {
    163  1.1  christos     return [join $args]
    164  1.1  christos   }
    165  1.1  christos   return "\033\[1m${args}\033\[0m"
    166  1.1  christos }
    167  1.1  christos 
    168  1.1  christos #
    169  1.1  christos # @proj-indented-notice ?-error? ?-notice? msg
    170  1.1  christos #
    171  1.1  christos # Takes a multi-line message and emits it with consistent indentation.
    172  1.1  christos # It does not perform any line-wrapping of its own. Which output
    173  1.1  christos # routine it uses depends on its flags, defaulting to msg-result.
    174  1.1  christos # For -error and -notice it uses user-notice.
    175  1.1  christos #
    176  1.1  christos # If the -notice flag it used then it emits using [user-notice], which
    177  1.1  christos # means its rendering will (A) go to stderr and (B) be delayed until
    178  1.1  christos # the next time autosetup goes to output a message.
    179  1.1  christos #
    180  1.1  christos # If the -error flag is provided then it renders the message
    181  1.1  christos # immediately to stderr and then exits.
    182  1.1  christos #
    183  1.1  christos # If neither -notice nor -error are used, the message will be sent to
    184  1.1  christos # stdout without delay.
    185  1.1  christos #
    186  1.1  christos proc proj-indented-notice {args} {
    187  1.1  christos   set fErr ""
    188  1.1  christos   set outFunc "msg-result"
    189  1.1  christos   while {[llength $args] > 1} {
    190  1.1  christos     switch -exact -- [lindex $args 0] {
    191  1.1  christos       -error  {
    192  1.1  christos         set args [lassign $args fErr]
    193  1.1  christos         set outFunc "user-notice"
    194  1.1  christos       }
    195  1.1  christos       -notice {
    196  1.1  christos         set args [lassign $args -]
    197  1.1  christos         set outFunc "user-notice"
    198  1.1  christos       }
    199  1.1  christos       default {
    200  1.1  christos         break
    201  1.1  christos       }
    202  1.1  christos     }
    203  1.1  christos   }
    204  1.1  christos   set lines [split [join $args] \n]
    205  1.1  christos   foreach line $lines {
    206  1.1  christos     set line [string trimleft $line]
    207  1.1  christos     if {"" eq $line} {
    208  1.1  christos       $outFunc $line
    209  1.1  christos     } else {
    210  1.1  christos       $outFunc "    $line"
    211  1.1  christos     }
    212  1.1  christos   }
    213  1.1  christos   if {"" ne $fErr} {
    214  1.1  christos     show-notices
    215  1.1  christos     exit 1
    216  1.1  christos   }
    217  1.1  christos }
    218  1.1  christos 
    219  1.1  christos #
    220  1.1  christos # @proj-is-cross-compiling
    221  1.1  christos #
    222  1.1  christos # Returns 1 if cross-compiling, else 0.
    223  1.1  christos #
    224  1.1  christos proc proj-is-cross-compiling {} {
    225  1.1  christos   expr {[get-define host] ne [get-define build]}
    226  1.1  christos }
    227  1.1  christos 
    228  1.1  christos #
    229  1.1  christos # @proj-strip-hash-comments value
    230  1.1  christos #
    231  1.1  christos # Expects to receive string input, which it splits on newlines, strips
    232  1.1  christos # out any lines which begin with any number of whitespace followed by
    233  1.1  christos # a '#', and returns a value containing the [append]ed results of each
    234  1.1  christos # remaining line with a \n between each. It does not strip out
    235  1.1  christos # comments which appear after the first non-whitespace character.
    236  1.1  christos #
    237  1.1  christos proc proj-strip-hash-comments {val} {
    238  1.1  christos   set x {}
    239  1.1  christos   foreach line [split $val \n] {
    240  1.1  christos     if {![string match "#*" [string trimleft $line]]} {
    241  1.1  christos       append x $line \n
    242  1.1  christos     }
    243  1.1  christos   }
    244  1.1  christos   return $x
    245  1.1  christos }
    246  1.1  christos 
    247  1.1  christos #
    248  1.1  christos # @proj-cflags-without-werror
    249  1.1  christos #
    250  1.1  christos # Fetches [define $var], strips out any -Werror entries, and returns
    251  1.1  christos # the new value. This is intended for temporarily stripping -Werror
    252  1.1  christos # from CFLAGS or CPPFLAGS within the scope of a [define-push] block.
    253  1.1  christos #
    254  1.1  christos proc proj-cflags-without-werror {{var CFLAGS}} {
    255  1.1  christos   set rv {}
    256  1.1  christos   foreach f [get-define $var ""] {
    257  1.1  christos     switch -exact -- $f {
    258  1.1  christos       -Werror {}
    259  1.1  christos       default { lappend rv $f }
    260  1.1  christos     }
    261  1.1  christos   }
    262  1.1  christos   join $rv " "
    263  1.1  christos }
    264  1.1  christos 
    265  1.1  christos #
    266  1.1  christos # @proj-check-function-in-lib
    267  1.1  christos #
    268  1.1  christos # A proxy for cc-check-function-in-lib with the following differences:
    269  1.1  christos #
    270  1.1  christos # - Does not make any global changes to the LIBS define.
    271  1.1  christos #
    272  1.1  christos # - Strips out the -Werror flag from CFLAGS before running the test,
    273  1.1  christos #   as these feature tests will often fail if -Werror is used.
    274  1.1  christos #
    275  1.1  christos # Returns the result of cc-check-function-in-lib (i.e. true or false).
    276  1.1  christos # The resulting linker flags are stored in the [define] named
    277  1.1  christos # lib_${function}.
    278  1.1  christos #
    279  1.1  christos proc proj-check-function-in-lib {function libs {otherlibs {}}} {
    280  1.1  christos   set found 0
    281  1.1  christos   define-push {LIBS CFLAGS} {
    282  1.1  christos     #puts "CFLAGS before=[get-define CFLAGS]"
    283  1.1  christos     define CFLAGS [proj-cflags-without-werror]
    284  1.1  christos     #puts "CFLAGS after =[get-define CFLAGS]"
    285  1.1  christos     set found [cc-check-function-in-lib $function $libs $otherlibs]
    286  1.1  christos   }
    287  1.1  christos   return $found
    288  1.1  christos }
    289  1.1  christos 
    290  1.1  christos #
    291  1.1  christos # @proj-search-for-header-dir ?-dirs LIST? ?-subdirs LIST? header
    292  1.1  christos #
    293  1.1  christos # Searches for $header in a combination of dirs and subdirs, specified
    294  1.1  christos # by the -dirs {LIST} and -subdirs {LIST} flags (each of which have
    295  1.1  christos # sane defaults). Returns either the first matching dir or an empty
    296  1.1  christos # string.  The return value does not contain the filename part.
    297  1.1  christos #
    298  1.1  christos proc proj-search-for-header-dir {header args} {
    299  1.1  christos   set subdirs {include}
    300  1.1  christos   set dirs {/usr /usr/local /mingw}
    301  1.1  christos # Debatable:
    302  1.1  christos #  if {![proj-is-cross-compiling]} {
    303  1.1  christos #    lappend dirs [get-define prefix]
    304  1.1  christos #  }
    305  1.1  christos   while {[llength $args]} {
    306  1.1  christos     switch -exact -- [lindex $args 0] {
    307  1.1  christos       -dirs     { set args [lassign $args - dirs] }
    308  1.1  christos       -subdirs  { set args [lassign $args - subdirs] }
    309  1.1  christos       default   {
    310  1.1  christos         proj-error "Unhandled argument: $args"
    311  1.1  christos       }
    312  1.1  christos     }
    313  1.1  christos   }
    314  1.1  christos   foreach dir $dirs {
    315  1.1  christos     foreach sub $subdirs {
    316  1.1  christos       if {[file exists $dir/$sub/$header]} {
    317  1.1  christos         return "$dir/$sub"
    318  1.1  christos       }
    319  1.1  christos     }
    320  1.1  christos   }
    321  1.1  christos   return ""
    322  1.1  christos }
    323  1.1  christos 
    324  1.1  christos #
    325  1.1  christos # @proj-find-executable-path ?-v? binaryName
    326  1.1  christos #
    327  1.1  christos # Works similarly to autosetup's [find-executable-path $binName] but:
    328  1.1  christos #
    329  1.1  christos # - If the first arg is -v, it's verbose about searching, else it's quiet.
    330  1.1  christos #
    331  1.1  christos # Returns the full path to the result or an empty string.
    332  1.1  christos #
    333  1.1  christos proc proj-find-executable-path {args} {
    334  1.1  christos   set binName $args
    335  1.1  christos   set verbose 0
    336  1.1  christos   if {[lindex $args 0] eq "-v"} {
    337  1.1  christos     set verbose 1
    338  1.1  christos     set args [lassign $args - binName]
    339  1.1  christos     msg-checking "Looking for $binName ... "
    340  1.1  christos   }
    341  1.1  christos   set check [find-executable-path $binName]
    342  1.1  christos   if {$verbose} {
    343  1.1  christos     if {"" eq $check} {
    344  1.1  christos       msg-result "not found"
    345  1.1  christos     } else {
    346  1.1  christos       msg-result $check
    347  1.1  christos     }
    348  1.1  christos   }
    349  1.1  christos   return $check
    350  1.1  christos }
    351  1.1  christos 
    352  1.1  christos #
    353  1.1  christos # @proj-bin-define binName ?defName?
    354  1.1  christos #
    355  1.1  christos # Uses [proj-find-executable-path $binName] to (verbosely) search for
    356  1.1  christos # a binary, sets a define (see below) to the result, and returns the
    357  1.1  christos # result (an empty string if not found).
    358  1.1  christos #
    359  1.1  christos # The define'd name is: If $defName is not empty, it is used as-is. If
    360  1.1  christos # $defName is empty then "BIN_X" is used, where X is the upper-case
    361  1.1  christos # form of $binName with any '-' characters replaced with '_'.
    362  1.1  christos #
    363  1.1  christos proc proj-bin-define {binName {defName {}}} {
    364  1.1  christos   set check [proj-find-executable-path -v $binName]
    365  1.1  christos   if {"" eq $defName} {
    366  1.1  christos     set defName "BIN_[string toupper [string map {- _} $binName]]"
    367  1.1  christos   }
    368  1.1  christos   define $defName $check
    369  1.1  christos   return $check
    370  1.1  christos }
    371  1.1  christos 
    372  1.1  christos #
    373  1.1  christos # @proj-first-bin-of bin...
    374  1.1  christos #
    375  1.1  christos # Looks for the first binary found of the names passed to this
    376  1.1  christos # function.  If a match is found, the full path to that binary is
    377  1.1  christos # returned, else "" is returned.
    378  1.1  christos #
    379  1.1  christos # Despite using cc-path-progs to do the search, this function clears
    380  1.1  christos # any define'd name that function stores for the result (because the
    381  1.1  christos # caller has no sensible way of knowing which [define] name it has
    382  1.1  christos # unless they pass only a single argument).
    383  1.1  christos #
    384  1.1  christos proc proj-first-bin-of {args} {
    385  1.1  christos   set rc ""
    386  1.1  christos   foreach b $args {
    387  1.1  christos     set u [string toupper $b]
    388  1.1  christos     # Note that cc-path-progs defines $u to "false" if it finds no
    389  1.1  christos     # match.
    390  1.1  christos     if {[cc-path-progs $b]} {
    391  1.1  christos       set rc [get-define $u]
    392  1.1  christos     }
    393  1.1  christos     undefine $u
    394  1.1  christos     if {"" ne $rc} break
    395  1.1  christos   }
    396  1.1  christos   return $rc
    397  1.1  christos }
    398  1.1  christos 
    399  1.1  christos #
    400  1.1  christos # @proj-opt-was-provided key
    401  1.1  christos #
    402  1.1  christos # Returns 1 if the user specifically provided the given configure flag
    403  1.1  christos # or if it was specifically set using proj-opt-set, else 0. This can
    404  1.1  christos # be used to distinguish between options which have a default value
    405  1.1  christos # and those which were explicitly provided by the user, even if the
    406  1.1  christos # latter is done in a way which uses the default value.
    407  1.1  christos #
    408  1.1  christos # For example, with a configure flag defined like:
    409  1.1  christos #
    410  1.1  christos #   { foo-bar:=baz => {its help text} }
    411  1.1  christos #
    412  1.1  christos # This function will, when passed foo-bar, return 1 only if the user
    413  1.1  christos # passes --foo-bar to configure, even if that invocation would resolve
    414  1.1  christos # to the default value of baz. If the user does not explicitly pass in
    415  1.1  christos # --foo-bar (with or without a value) then this returns 0.
    416  1.1  christos #
    417  1.1  christos # Calling [proj-opt-set] is, for purposes of the above, equivalent to
    418  1.1  christos # explicitly passing in the flag.
    419  1.1  christos #
    420  1.1  christos # Note: unlike most functions which deal with configure --flags, this
    421  1.1  christos # one does not validate that $key refers to a pre-defined flag. i.e.
    422  1.1  christos # it accepts arbitrary keys, even those not defined via an [options]
    423  1.1  christos # call. [proj-opt-set] manipulates the internal list of flags, such
    424  1.1  christos # that new options set via that function will cause this function to
    425  1.1  christos # return true. (That's an unintended and unavoidable side-effect, not
    426  1.1  christos # specifically a feature which should be made use of.)
    427  1.1  christos #
    428  1.1  christos proc proj-opt-was-provided {key} {
    429  1.1  christos   dict exists $::autosetup(optset) $key
    430  1.1  christos }
    431  1.1  christos 
    432  1.1  christos #
    433  1.1  christos # @proj-opt-set flag ?val?
    434  1.1  christos #
    435  1.1  christos # Force-set autosetup option $flag to $val. The value can be fetched
    436  1.1  christos # later with [opt-val], [opt-bool], and friends.
    437  1.1  christos #
    438  1.1  christos # Returns $val.
    439  1.1  christos #
    440  1.1  christos proc proj-opt-set {flag {val 1}} {
    441  1.1  christos   if {$flag ni $::autosetup(options)} {
    442  1.1  christos     # We have to add this to autosetup(options) or else future calls
    443  1.1  christos     # to [opt-bool $flag] will fail validation of $flag.
    444  1.1  christos     lappend ::autosetup(options) $flag
    445  1.1  christos   }
    446  1.1  christos   dict set ::autosetup(optset) $flag $val
    447  1.1  christos   return $val
    448  1.1  christos }
    449  1.1  christos 
    450  1.1  christos #
    451  1.1  christos # @proj-opt-exists flag
    452  1.1  christos #
    453  1.1  christos # Returns 1 if the given flag has been defined as a legal configure
    454  1.1  christos # option, else returns 0. Options set via proj-opt-set "exist" for
    455  1.1  christos # this purpose even if they were not defined via autosetup's
    456  1.1  christos # [options] function.
    457  1.1  christos #
    458  1.1  christos proc proj-opt-exists {flag} {
    459  1.1  christos   expr {$flag in $::autosetup(options)};
    460  1.1  christos }
    461  1.1  christos 
    462  1.1  christos #
    463  1.1  christos # @proj-val-truthy val
    464  1.1  christos #
    465  1.1  christos # Returns 1 if $val appears to be a truthy value, else returns
    466  1.1  christos # 0. Truthy values are any of {1 on true yes enabled}
    467  1.1  christos #
    468  1.1  christos proc proj-val-truthy {val} {
    469  1.1  christos   expr {$val in {1 on true yes enabled}}
    470  1.1  christos }
    471  1.1  christos 
    472  1.1  christos #
    473  1.1  christos # @proj-opt-truthy flag
    474  1.1  christos #
    475  1.1  christos # Returns 1 if [opt-val $flag] appears to be a truthy value or
    476  1.1  christos # [opt-bool $flag] is true. See proj-val-truthy.
    477  1.1  christos #
    478  1.1  christos proc proj-opt-truthy {flag} {
    479  1.1  christos   if {[proj-val-truthy [opt-val $flag]]} { return 1 }
    480  1.1  christos   set rc 0
    481  1.1  christos   catch {
    482  1.1  christos     # opt-bool will throw if $flag is not a known boolean flag
    483  1.1  christos     set rc [opt-bool $flag]
    484  1.1  christos   }
    485  1.1  christos   return $rc
    486  1.1  christos }
    487  1.1  christos 
    488  1.1  christos #
    489  1.1  christos # @proj-if-opt-truthy boolFlag thenScript ?elseScript?
    490  1.1  christos #
    491  1.1  christos # If [proj-opt-truthy $flag] is true, eval $then, else eval $else.
    492  1.1  christos #
    493  1.1  christos proc proj-if-opt-truthy {boolFlag thenScript {elseScript {}}} {
    494  1.1  christos   if {[proj-opt-truthy $boolFlag]} {
    495  1.1  christos     uplevel 1 $thenScript
    496  1.1  christos   } else {
    497  1.1  christos     uplevel 1 $elseScript
    498  1.1  christos   }
    499  1.1  christos }
    500  1.1  christos 
    501  1.1  christos #
    502  1.1  christos # @proj-define-for-opt flag def ?msg? ?iftrue? ?iffalse?
    503  1.1  christos #
    504  1.1  christos # If [proj-opt-truthy $flag] then [define $def $iftrue] else [define
    505  1.1  christos # $def $iffalse]. If $msg is not empty, output [msg-checking $msg] and
    506  1.1  christos # a [msg-results ...] which corresponds to the result. Returns 1 if
    507  1.1  christos # the opt-truthy check passes, else 0.
    508  1.1  christos #
    509  1.1  christos proc proj-define-for-opt {flag def {msg ""} {iftrue 1} {iffalse 0}} {
    510  1.1  christos   if {"" ne $msg} {
    511  1.1  christos     msg-checking "$msg "
    512  1.1  christos   }
    513  1.1  christos   set rcMsg ""
    514  1.1  christos   set rc 0
    515  1.1  christos   if {[proj-opt-truthy $flag]} {
    516  1.1  christos     define $def $iftrue
    517  1.1  christos     set rc 1
    518  1.1  christos   } else {
    519  1.1  christos     define $def $iffalse
    520  1.1  christos   }
    521  1.1  christos   switch -- [proj-val-truthy [get-define $def]] {
    522  1.1  christos     0 { set rcMsg no }
    523  1.1  christos     1 { set rcMsg yes }
    524  1.1  christos   }
    525  1.1  christos   if {"" ne $msg} {
    526  1.1  christos     msg-result $rcMsg
    527  1.1  christos   }
    528  1.1  christos   return $rc
    529  1.1  christos }
    530  1.1  christos 
    531  1.1  christos #
    532  1.1  christos # @proj-opt-define-bool ?-v? optName defName ?descr?
    533  1.1  christos #
    534  1.1  christos # Checks [proj-opt-truthy $optName] and calls [define $defName X]
    535  1.1  christos # where X is 0 for false and 1 for true. $descr is an optional
    536  1.1  christos # [msg-checking] argument which defaults to $defName. Returns X.
    537  1.1  christos #
    538  1.1  christos # If args[0] is -v then the boolean semantics are inverted: if
    539  1.1  christos # the option is set, it gets define'd to 0, else 1. Returns the
    540  1.1  christos # define'd value.
    541  1.1  christos #
    542  1.1  christos proc proj-opt-define-bool {args} {
    543  1.1  christos   set invert 0
    544  1.1  christos   if {[lindex $args 0] eq "-v"} {
    545  1.1  christos     incr invert
    546  1.1  christos     lassign $args - optName defName descr
    547  1.1  christos   } else {
    548  1.1  christos     lassign $args optName defName descr
    549  1.1  christos   }
    550  1.1  christos   if {"" eq $descr} {
    551  1.1  christos     set descr $defName
    552  1.1  christos   }
    553  1.1  christos   #puts "optName=$optName defName=$defName descr=$descr"
    554  1.1  christos   set rc 0
    555  1.1  christos   msg-checking "[join $descr] ... "
    556  1.1  christos   set rc [proj-opt-truthy $optName]
    557  1.1  christos   if {$invert} {
    558  1.1  christos     set rc [expr {!$rc}]
    559  1.1  christos   }
    560  1.1  christos   msg-result [string map {0 no 1 yes} $rc]
    561  1.1  christos   define $defName $rc
    562  1.1  christos   return $rc
    563  1.1  christos }
    564  1.1  christos 
    565  1.1  christos #
    566  1.1  christos # @proj-check-module-loader
    567  1.1  christos #
    568  1.1  christos # Check for module-loading APIs (libdl/libltdl)...
    569  1.1  christos #
    570  1.1  christos # Looks for libltdl or dlopen(), the latter either in -ldl or built in
    571  1.1  christos # to libc (as it is on some platforms). Returns 1 if found, else
    572  1.1  christos # 0. Either way, it `define`'s:
    573  1.1  christos #
    574  1.1  christos #  - HAVE_LIBLTDL to 1 or 0 if libltdl is found/not found
    575  1.1  christos #  - HAVE_LIBDL to 1 or 0 if dlopen() is found/not found
    576  1.1  christos #  - LDFLAGS_MODULE_LOADER one of ("-lltdl", "-ldl", or ""), noting
    577  1.1  christos #    that -ldl may legally be empty on some platforms even if
    578  1.1  christos #    HAVE_LIBDL is true (indicating that dlopen() is available without
    579  1.1  christos #    extra link flags). LDFLAGS_MODULE_LOADER also gets "-rdynamic" appended
    580  1.1  christos #    to it because otherwise trying to open DLLs will result in undefined
    581  1.1  christos #    symbol errors.
    582  1.1  christos #
    583  1.1  christos # Note that if it finds LIBLTDL it does not look for LIBDL, so will
    584  1.1  christos # report only that is has LIBLTDL.
    585  1.1  christos #
    586  1.1  christos proc proj-check-module-loader {} {
    587  1.1  christos   msg-checking "Looking for module-loader APIs... "
    588  1.1  christos   if {99 ne [get-define LDFLAGS_MODULE_LOADER 99]} {
    589  1.1  christos     if {1 eq [get-define HAVE_LIBLTDL 0]} {
    590  1.1  christos       msg-result "(cached) libltdl"
    591  1.1  christos       return 1
    592  1.1  christos     } elseif {1 eq [get-define HAVE_LIBDL 0]} {
    593  1.1  christos       msg-result "(cached) libdl"
    594  1.1  christos       return 1
    595  1.1  christos     }
    596  1.1  christos     # else: wha???
    597  1.1  christos   }
    598  1.1  christos   set HAVE_LIBLTDL 0
    599  1.1  christos   set HAVE_LIBDL 0
    600  1.1  christos   set LDFLAGS_MODULE_LOADER ""
    601  1.1  christos   set rc 0
    602  1.1  christos   puts "" ;# cosmetic kludge for cc-check-XXX
    603  1.1  christos   if {[cc-check-includes ltdl.h] && [cc-check-function-in-lib lt_dlopen ltdl]} {
    604  1.1  christos     set HAVE_LIBLTDL 1
    605  1.1  christos     set LDFLAGS_MODULE_LOADER "-lltdl -rdynamic"
    606  1.1  christos     msg-result " - Got libltdl."
    607  1.1  christos     set rc 1
    608  1.1  christos   } elseif {[cc-with {-includes dlfcn.h} {
    609  1.1  christos     cctest -link 1 -declare "extern char* dlerror(void);" -code "dlerror();"}]} {
    610  1.1  christos     msg-result " - This system can use dlopen() without -ldl."
    611  1.1  christos     set HAVE_LIBDL 1
    612  1.1  christos     set LDFLAGS_MODULE_LOADER ""
    613  1.1  christos     set rc 1
    614  1.1  christos   } elseif {[cc-check-includes dlfcn.h]} {
    615  1.1  christos     set HAVE_LIBDL 1
    616  1.1  christos     set rc 1
    617  1.1  christos     if {[cc-check-function-in-lib dlopen dl]} {
    618  1.1  christos       msg-result " - dlopen() needs libdl."
    619  1.1  christos       set LDFLAGS_MODULE_LOADER "-ldl -rdynamic"
    620  1.1  christos     } else {
    621  1.1  christos       msg-result " - dlopen() not found in libdl. Assuming dlopen() is built-in."
    622  1.1  christos       set LDFLAGS_MODULE_LOADER "-rdynamic"
    623  1.1  christos     }
    624  1.1  christos   }
    625  1.1  christos   define HAVE_LIBLTDL $HAVE_LIBLTDL
    626  1.1  christos   define HAVE_LIBDL $HAVE_LIBDL
    627  1.1  christos   define LDFLAGS_MODULE_LOADER $LDFLAGS_MODULE_LOADER
    628  1.1  christos   return $rc
    629  1.1  christos }
    630  1.1  christos 
    631  1.1  christos #
    632  1.1  christos # @proj-no-check-module-loader
    633  1.1  christos #
    634  1.1  christos # Sets all flags which would be set by proj-check-module-loader to
    635  1.1  christos # empty/falsy values, as if those checks had failed to find a module
    636  1.1  christos # loader. Intended to be called in place of that function when
    637  1.1  christos # a module loader is explicitly not desired.
    638  1.1  christos #
    639  1.1  christos proc proj-no-check-module-loader {} {
    640  1.1  christos   define HAVE_LIBDL 0
    641  1.1  christos   define HAVE_LIBLTDL 0
    642  1.1  christos   define LDFLAGS_MODULE_LOADER ""
    643  1.1  christos }
    644  1.1  christos 
    645  1.1  christos #
    646  1.1  christos # @proj-file-content ?-trim? filename
    647  1.1  christos #
    648  1.1  christos # Opens the given file, reads all of its content, and returns it.  If
    649  1.1  christos # the first arg is -trim, the contents of the file named by the second
    650  1.1  christos # argument are trimmed before returning them.
    651  1.1  christos #
    652  1.1  christos proc proj-file-content {args} {
    653  1.1  christos   set trim 0
    654  1.1  christos   set fname $args
    655  1.1  christos   if {"-trim" eq [lindex $args 0]} {
    656  1.1  christos     set trim 1
    657  1.1  christos     lassign $args - fname
    658  1.1  christos   }
    659  1.1  christos   set fp [open $fname rb]
    660  1.1  christos   set rc [read $fp]
    661  1.1  christos   close $fp
    662  1.1  christos   if {$trim} { return [string trim $rc] }
    663  1.1  christos   return $rc
    664  1.1  christos }
    665  1.1  christos 
    666  1.1  christos #
    667  1.1  christos # @proj-file-conent filename
    668  1.1  christos #
    669  1.1  christos # Returns the contents of the given file as an array of lines, with
    670  1.1  christos # the EOL stripped from each input line.
    671  1.1  christos #
    672  1.1  christos proc proj-file-content-list {fname} {
    673  1.1  christos   set fp [open $fname rb]
    674  1.1  christos   set rc {}
    675  1.1  christos   while { [gets $fp line] >= 0 } {
    676  1.1  christos     lappend rc $line
    677  1.1  christos   }
    678  1.1  christos   close $fp
    679  1.1  christos   return $rc
    680  1.1  christos }
    681  1.1  christos 
    682  1.1  christos #
    683  1.1  christos # @proj-file-write ?-ro? fname content
    684  1.1  christos #
    685  1.1  christos # Works like autosetup's [writefile] but explicitly uses binary mode
    686  1.1  christos # to avoid EOL translation on Windows. If $fname already exists, it is
    687  1.1  christos # overwritten, even if it's flagged as read-only.
    688  1.1  christos #
    689  1.1  christos proc proj-file-write {args} {
    690  1.1  christos   if {"-ro" eq [lindex $args 0]} {
    691  1.1  christos     lassign $args ro fname content
    692  1.1  christos   } else {
    693  1.1  christos     set ro ""
    694  1.1  christos     lassign $args fname content
    695  1.1  christos   }
    696  1.1  christos   file delete -force -- $fname; # in case it's read-only
    697  1.1  christos   set f [open $fname wb]
    698  1.1  christos   puts -nonewline $f $content
    699  1.1  christos   close $f
    700  1.1  christos   if {"" ne $ro} {
    701  1.1  christos     catch {
    702  1.1  christos       exec chmod -w $fname
    703  1.1  christos       #file attributes -w $fname; #jimtcl has no 'attributes'
    704  1.1  christos     }
    705  1.1  christos   }
    706  1.1  christos }
    707  1.1  christos 
    708  1.1  christos #
    709  1.1  christos # @proj-check-compile-commands ?-assume-for-clang? ?configFlag?
    710  1.1  christos #
    711  1.1  christos # Checks the compiler for compile_commands.json support. If
    712  1.1  christos # $configFlag is not empty then it is assumed to be the name of an
    713  1.1  christos # autosetup boolean config which controls whether to run/skip this
    714  1.1  christos # check.
    715  1.1  christos #
    716  1.1  christos # If -assume-for-clang is provided and $configFlag is not empty and CC
    717  1.1  christos # matches *clang* and no --$configFlag was explicitly provided to the
    718  1.1  christos # configure script then behave as if --$configFlag had been provided.
    719  1.1  christos # To disable that assumption, either don't pass -assume-for-clang or
    720  1.1  christos # pass --$configFlag=0 to the configure script. (The reason for this
    721  1.1  christos # behavior is that clang supports compile-commands but some other
    722  1.1  christos # compilers report false positives with these tests.)
    723  1.1  christos #
    724  1.1  christos # Returns 1 if supported, else 0, and defines HAVE_COMPILE_COMMANDS to
    725  1.1  christos # that value. Defines MAKE_COMPILATION_DB to "yes" if supported, "no"
    726  1.1  christos # if not. The use of MAKE_COMPILATION_DB is deprecated/discouraged:
    727  1.1  christos # HAVE_COMPILE_COMMANDS is preferred.
    728  1.1  christos #
    729  1.1  christos # ACHTUNG: this test has a long history of false positive results
    730  1.1  christos # because of compilers reacting differently to the -MJ flag.  Because
    731  1.1  christos # of this, it is recommended that this support be an opt-in feature,
    732  1.1  christos # rather than an on-by-default default one. That is: in the
    733  1.1  christos # configure script define the option as
    734  1.1  christos # {--the-flag-name=0 => {Enable ....}}
    735  1.1  christos #
    736  1.1  christos proc proj-check-compile-commands {args} {
    737  1.1  christos   set i 0
    738  1.1  christos   set configFlag {}
    739  1.1  christos   set fAssumeForClang 0
    740  1.1  christos   set doAssume 0
    741  1.1  christos   msg-checking "compile_commands.json support... "
    742  1.1  christos   if {"-assume-for-clang" eq [lindex $args 0]} {
    743  1.1  christos     lassign $args - configFlag
    744  1.1  christos     incr fAssumeForClang
    745  1.1  christos   } elseif {1 == [llength $args]} {
    746  1.1  christos     lassign $args configFlag
    747  1.1  christos   } else {
    748  1.1  christos     proj-error "Invalid arguments"
    749  1.1  christos   }
    750  1.1  christos   if {1 == $fAssumeForClang && "" ne $configFlag} {
    751  1.1  christos     if {[string match *clang* [get-define CC]]
    752  1.1  christos         && ![proj-opt-was-provided $configFlag]
    753  1.1  christos         && ![proj-opt-truthy $configFlag]} {
    754  1.1  christos       proj-indented-notice [subst -nocommands -nobackslashes {
    755  1.1  christos         CC appears to be clang, so assuming that --$configFlag is likely
    756  1.1  christos         to work. To disable this assumption use --$configFlag=0.}]
    757  1.1  christos       incr doAssume
    758  1.1  christos     }
    759  1.1  christos   }
    760  1.1  christos   if {!$doAssume && "" ne $configFlag && ![proj-opt-truthy $configFlag]} {
    761  1.1  christos     msg-result "check disabled. Use --${configFlag} to enable it."
    762  1.1  christos     define HAVE_COMPILE_COMMANDS 0
    763  1.1  christos     define MAKE_COMPILATION_DB no
    764  1.1  christos     return 0
    765  1.1  christos   } else {
    766  1.1  christos     if {[cctest -lang c -cflags {/dev/null -MJ} -source {}]} {
    767  1.1  christos       # This test reportedly incorrectly succeeds on one of
    768  1.1  christos       # Martin G.'s older systems. drh also reports a false
    769  1.1  christos       # positive on an unspecified older Mac system.
    770  1.1  christos       msg-result "compiler supports -MJ. Assuming it's useful for compile_commands.json"
    771  1.1  christos       define MAKE_COMPILATION_DB yes; # deprecated
    772  1.1  christos       define HAVE_COMPILE_COMMANDS 1
    773  1.1  christos       return 1
    774  1.1  christos     } else {
    775  1.1  christos       msg-result "compiler does not support compile_commands.json"
    776  1.1  christos       define MAKE_COMPILATION_DB no
    777  1.1  christos       define HAVE_COMPILE_COMMANDS 0
    778  1.1  christos       return 0
    779  1.1  christos     }
    780  1.1  christos   }
    781  1.1  christos }
    782  1.1  christos 
    783  1.1  christos #
    784  1.1  christos # @proj-touch filename
    785  1.1  christos #
    786  1.1  christos # Runs the 'touch' external command on one or more files, ignoring any
    787  1.1  christos # errors.
    788  1.1  christos #
    789  1.1  christos proc proj-touch {filename} {
    790  1.1  christos   catch { exec touch {*}$filename }
    791  1.1  christos }
    792  1.1  christos 
    793  1.1  christos #
    794  1.1  christos # @proj-make-from-dot-in ?-touch? infile ?outfile?
    795  1.1  christos #
    796  1.1  christos # Uses [make-template] to create makefile(-like) file(s) $outfile from
    797  1.1  christos # $infile but explicitly makes the output read-only, to avoid
    798  1.1  christos # inadvertent editing (who, me?).
    799  1.1  christos #
    800  1.1  christos # If $outfile is empty then:
    801  1.1  christos #
    802  1.1  christos # - If $infile is a 2-element list, it is assumed to be an in/out pair,
    803  1.1  christos #   and $outfile is set from the 2nd entry in that list. Else...
    804  1.1  christos #
    805  1.1  christos # - $outfile is set to $infile stripped of its extension.
    806  1.1  christos #
    807  1.1  christos # If the first argument is -touch then the generated file is touched
    808  1.1  christos # to update its timestamp. This can be used as a workaround for
    809  1.1  christos # cases where (A) autosetup does not update the file because it was
    810  1.1  christos # not really modified and (B) the file *really* needs to be updated to
    811  1.1  christos # please the build process.
    812  1.1  christos #
    813  1.1  christos # Failures when running chmod or touch are silently ignored.
    814  1.1  christos #
    815  1.1  christos proc proj-make-from-dot-in {args} {
    816  1.1  christos   set fIn ""
    817  1.1  christos   set fOut ""
    818  1.1  christos   set touch 0
    819  1.1  christos   if {[lindex $args 0] eq "-touch"} {
    820  1.1  christos     set touch 1
    821  1.1  christos     lassign $args - fIn fOut
    822  1.1  christos   } else {
    823  1.1  christos     lassign $args fIn fOut
    824  1.1  christos   }
    825  1.1  christos   if {"" eq $fOut} {
    826  1.1  christos     if {[llength $fIn]>1} {
    827  1.1  christos       lassign $fIn fIn fOut
    828  1.1  christos     } else {
    829  1.1  christos       set fOut [file rootname $fIn]
    830  1.1  christos     }
    831  1.1  christos   }
    832  1.1  christos   #puts "filenames=$filename"
    833  1.1  christos   if {[file exists $fOut]} {
    834  1.1  christos     catch { exec chmod u+w $fOut }
    835  1.1  christos   }
    836  1.1  christos   #puts "making template: $fIn ==> $fOut"
    837  1.1  christos   #define-push {top_srcdir} {
    838  1.1  christos     #puts "--- $fIn $fOut top_srcdir=[get-define top_srcdir]"
    839  1.1  christos     make-template $fIn $fOut
    840  1.1  christos     #puts "--- $fIn $fOut top_srcdir=[get-define top_srcdir]"
    841  1.1  christos     # make-template modifies top_srcdir
    842  1.1  christos   #}
    843  1.1  christos   if {$touch} {
    844  1.1  christos     proj-touch $fOut
    845  1.1  christos   }
    846  1.1  christos   catch {
    847  1.1  christos     exec chmod -w $fOut
    848  1.1  christos     #file attributes -w $f; #jimtcl has no 'attributes'
    849  1.1  christos   }
    850  1.1  christos }
    851  1.1  christos 
    852  1.1  christos #
    853  1.1  christos # @proj-check-profile-flag ?flagname?
    854  1.1  christos #
    855  1.1  christos # Checks for the boolean configure option named by $flagname. If set,
    856  1.1  christos # it checks if $CC seems to refer to gcc. If it does (or appears to)
    857  1.1  christos # then it defines CC_PROFILE_FLAG to "-pg" and returns 1, else it
    858  1.1  christos # defines CC_PROFILE_FLAG to "" and returns 0.
    859  1.1  christos #
    860  1.1  christos # Note that the resulting flag must be added to both CFLAGS and
    861  1.1  christos # LDFLAGS in order for binaries to be able to generate "gmon.out".  In
    862  1.1  christos # order to avoid potential problems with escaping, space-containing
    863  1.1  christos # tokens, and interfering with autosetup's use of these vars, this
    864  1.1  christos # routine does not directly modify CFLAGS or LDFLAGS.
    865  1.1  christos #
    866  1.1  christos proc proj-check-profile-flag {{flagname profile}} {
    867  1.1  christos   #puts "flagname=$flagname ?[proj-opt-truthy $flagname]?"
    868  1.1  christos   if {[proj-opt-truthy $flagname]} {
    869  1.1  christos     set CC [get-define CC]
    870  1.1  christos     regsub {.*ccache *} $CC "" CC
    871  1.1  christos     # ^^^ if CC="ccache gcc" then [exec] treats "ccache gcc" as a
    872  1.1  christos     # single binary name and fails. So strip any leading ccache part
    873  1.1  christos     # for this purpose.
    874  1.1  christos     if { ![catch { exec $CC --version } msg]} {
    875  1.1  christos       if {[string first gcc $CC] != -1} {
    876  1.1  christos         define CC_PROFILE_FLAG "-pg"
    877  1.1  christos         return 1
    878  1.1  christos       }
    879  1.1  christos     }
    880  1.1  christos   }
    881  1.1  christos   define CC_PROFILE_FLAG ""
    882  1.1  christos   return 0
    883  1.1  christos }
    884  1.1  christos 
    885  1.1  christos #
    886  1.1  christos # @proj-looks-like-windows ?key?
    887  1.1  christos #
    888  1.1  christos # Returns 1 if this appears to be a Windows environment (MinGw,
    889  1.1  christos # Cygwin, MSys), else returns 0. The optional argument is the name of
    890  1.1  christos # an autosetup define which contains platform name info, defaulting to
    891  1.1  christos # "host" (meaning, somewhat counterintuitively, the target system, not
    892  1.1  christos # the current host). The other legal value is "build" (the build
    893  1.1  christos # machine, i.e. the local host). If $key == "build" then some
    894  1.1  christos # additional checks may be performed which are not applicable when
    895  1.1  christos # $key == "host".
    896  1.1  christos #
    897  1.1  christos proc proj-looks-like-windows {{key host}} {
    898  1.1  christos   global autosetup
    899  1.1  christos   switch -glob -- [get-define $key] {
    900  1.1  christos     *-*-ming* - *-*-cygwin - *-*-msys - *windows* {
    901  1.1  christos       return 1
    902  1.1  christos     }
    903  1.1  christos   }
    904  1.1  christos   if {$key eq "build"} {
    905  1.1  christos     # These apply only to the local OS, not a cross-compilation target,
    906  1.1  christos     # as the above check potentially can.
    907  1.1  christos     if {$::autosetup(iswin)} { return 1 }
    908  1.1  christos     if {[find-an-executable cygpath] ne "" || $::tcl_platform(os) eq "Windows NT"} {
    909  1.1  christos       return 1
    910  1.1  christos     }
    911  1.1  christos   }
    912  1.1  christos   return 0
    913  1.1  christos }
    914  1.1  christos 
    915  1.1  christos #
    916  1.1  christos # @proj-looks-like-mac ?key?
    917  1.1  christos #
    918  1.1  christos # Looks at either the 'host' (==compilation target platform) or
    919  1.1  christos # 'build' (==the being-built-on platform) define value and returns if
    920  1.1  christos # if that value seems to indicate that it represents a Mac platform,
    921  1.1  christos # else returns 0.
    922  1.1  christos #
    923  1.1  christos proc proj-looks-like-mac {{key host}} {
    924  1.1  christos   switch -glob -- [get-define $key] {
    925  1.1  christos     *-*-darwin* {
    926  1.1  christos       # https://sqlite.org/forum/forumpost/7b218c3c9f207646
    927  1.1  christos       # There's at least one Linux out there which matches *apple*.
    928  1.1  christos       return 1
    929  1.1  christos     }
    930  1.1  christos     default {
    931  1.1  christos       return 0
    932  1.1  christos     }
    933  1.1  christos   }
    934  1.1  christos }
    935  1.1  christos 
    936  1.1  christos #
    937  1.1  christos # @proj-exe-extension
    938  1.1  christos #
    939  1.1  christos # Checks autosetup's "host" and "build" defines to see if the build
    940  1.1  christos # host and target are Windows-esque (Cygwin, MinGW, MSys). If the
    941  1.1  christos # build environment is then BUILD_EXEEXT is [define]'d to ".exe", else
    942  1.1  christos # "". If the target, a.k.a. "host", is then TARGET_EXEEXT is
    943  1.1  christos # [define]'d to ".exe", else "".
    944  1.1  christos #
    945  1.1  christos proc proj-exe-extension {} {
    946  1.1  christos   set rH ""
    947  1.1  christos   set rB ""
    948  1.1  christos   if {[proj-looks-like-windows host]} {
    949  1.1  christos     set rH ".exe"
    950  1.1  christos   }
    951  1.1  christos   if {[proj-looks-like-windows build]} {
    952  1.1  christos     set rB ".exe"
    953  1.1  christos   }
    954  1.1  christos   define BUILD_EXEEXT $rB
    955  1.1  christos   define TARGET_EXEEXT $rH
    956  1.1  christos }
    957  1.1  christos 
    958  1.1  christos #
    959  1.1  christos # @proj-dll-extension
    960  1.1  christos #
    961  1.1  christos # Works like proj-exe-extension except that it defines BUILD_DLLEXT
    962  1.1  christos # and TARGET_DLLEXT to one of (.so, ,dll, .dylib).
    963  1.1  christos #
    964  1.1  christos # Trivia: for .dylib files, the linker needs the -dynamiclib flag
    965  1.1  christos # instead of -shared.
    966  1.1  christos #
    967  1.1  christos proc proj-dll-extension {} {
    968  1.1  christos   set inner {{key} {
    969  1.1  christos     if {[proj-looks-like-mac $key]} {
    970  1.1  christos       return ".dylib"
    971  1.1  christos     }
    972  1.1  christos     if {[proj-looks-like-windows $key]} {
    973  1.1  christos       return ".dll"
    974  1.1  christos     }
    975  1.1  christos     return ".so"
    976  1.1  christos   }}
    977  1.1  christos   define BUILD_DLLEXT [apply $inner build]
    978  1.1  christos   define TARGET_DLLEXT [apply $inner host]
    979  1.1  christos }
    980  1.1  christos 
    981  1.1  christos #
    982  1.1  christos # @proj-lib-extension
    983  1.1  christos #
    984  1.1  christos # Static-library counterpart of proj-dll-extension. Defines
    985  1.1  christos # BUILD_LIBEXT and TARGET_LIBEXT to the conventional static library
    986  1.1  christos # extension for the being-built-on resp. the target platform.
    987  1.1  christos #
    988  1.1  christos proc proj-lib-extension {} {
    989  1.1  christos   set inner {{key} {
    990  1.1  christos     switch -glob -- [get-define $key] {
    991  1.1  christos       *-*-ming* - *-*-cygwin - *-*-msys {
    992  1.1  christos         return ".a"
    993  1.1  christos         # ^^^ this was ".lib" until 2025-02-07. See
    994  1.1  christos         # https://sqlite.org/forum/forumpost/02db2d4240
    995  1.1  christos       }
    996  1.1  christos       default {
    997  1.1  christos         return ".a"
    998  1.1  christos       }
    999  1.1  christos     }
   1000  1.1  christos   }}
   1001  1.1  christos   define BUILD_LIBEXT [apply $inner build]
   1002  1.1  christos   define TARGET_LIBEXT [apply $inner host]
   1003  1.1  christos }
   1004  1.1  christos 
   1005  1.1  christos #
   1006  1.1  christos # @proj-file-extensions
   1007  1.1  christos #
   1008  1.1  christos # Calls all of the proj-*-extension functions.
   1009  1.1  christos #
   1010  1.1  christos proc proj-file-extensions {} {
   1011  1.1  christos   proj-exe-extension
   1012  1.1  christos   proj-dll-extension
   1013  1.1  christos   proj-lib-extension
   1014  1.1  christos }
   1015  1.1  christos 
   1016  1.1  christos #
   1017  1.1  christos # @proj-affirm-files-exist ?-v? filename...
   1018  1.1  christos #
   1019  1.1  christos # Expects a list of file names. If any one of them does not exist in
   1020  1.1  christos # the filesystem, it fails fatally with an informative message.
   1021  1.1  christos # Returns the last file name it checks. If the first argument is -v
   1022  1.1  christos # then it emits msg-checking/msg-result messages for each file.
   1023  1.1  christos #
   1024  1.1  christos proc proj-affirm-files-exist {args} {
   1025  1.1  christos   set rc ""
   1026  1.1  christos   set verbose 0
   1027  1.1  christos   if {[lindex $args 0] eq "-v"} {
   1028  1.1  christos     set verbose 1
   1029  1.1  christos     set args [lrange $args 1 end]
   1030  1.1  christos   }
   1031  1.1  christos   foreach f $args {
   1032  1.1  christos     if {$verbose} { msg-checking "Looking for $f ... " }
   1033  1.1  christos     if {![file exists $f]} {
   1034  1.1  christos       user-error "not found: $f"
   1035  1.1  christos     }
   1036  1.1  christos     if {$verbose} { msg-result "" }
   1037  1.1  christos     set rc $f
   1038  1.1  christos   }
   1039  1.1  christos   return rc
   1040  1.1  christos }
   1041  1.1  christos 
   1042  1.1  christos #
   1043  1.1  christos # @proj-check-emsdk
   1044  1.1  christos #
   1045  1.1  christos # Emscripten is used for doing in-tree builds of web-based WASM stuff,
   1046  1.1  christos # as opposed to WASI-based WASM or WASM binaries we import from other
   1047  1.1  christos # places. This is only set up for Unix-style OSes and is untested
   1048  1.1  christos # anywhere but Linux. Requires that the --with-emsdk flag be
   1049  1.1  christos # registered with autosetup.
   1050  1.1  christos #
   1051  1.1  christos # It looks for the SDK in the location specified by --with-emsdk.
   1052  1.1  christos # Values of "" or "auto" mean to check for the environment var EMSDK
   1053  1.1  christos # (which gets set by the emsdk_env.sh script from the SDK) or that
   1054  1.1  christos # same var passed to configure.
   1055  1.1  christos #
   1056  1.1  christos # If the given directory is found, it expects to find emsdk_env.sh in
   1057  1.1  christos # that directory, as well as the emcc compiler somewhere under there.
   1058  1.1  christos #
   1059  1.1  christos # If the --with-emsdk[=DIR] flag is explicitly provided and the SDK is
   1060  1.1  christos # not found then a fatal error is generated, otherwise failure to find
   1061  1.1  christos # the SDK is not fatal.
   1062  1.1  christos #
   1063  1.1  christos # Defines the following:
   1064  1.1  christos #
   1065  1.1  christos # - HAVE_EMSDK = 0 or 1 (this function's return value)
   1066  1.1  christos # - EMSDK_HOME = "" or top dir of the emsdk
   1067  1.1  christos # - EMSDK_ENV_SH = "" or $EMSDK_HOME/emsdk_env.sh
   1068  1.1  christos # - BIN_EMCC = "" or $EMSDK_HOME/upstream/emscripten/emcc
   1069  1.1  christos #
   1070  1.1  christos # Returns 1 if EMSDK_ENV_SH is found, else 0.  If EMSDK_HOME is not empty
   1071  1.1  christos # but BIN_EMCC is then emcc was not found in the EMSDK_HOME, in which
   1072  1.1  christos # case we have to rely on the fact that sourcing $EMSDK_ENV_SH from a
   1073  1.1  christos # shell will add emcc to the $PATH.
   1074  1.1  christos #
   1075  1.1  christos proc proj-check-emsdk {} {
   1076  1.1  christos   set emsdkHome [opt-val with-emsdk]
   1077  1.1  christos   define EMSDK_HOME ""
   1078  1.1  christos   define EMSDK_ENV_SH ""
   1079  1.1  christos   define BIN_EMCC ""
   1080  1.1  christos   set hadValue [llength $emsdkHome]
   1081  1.1  christos   msg-checking "Emscripten SDK? "
   1082  1.1  christos   if {$emsdkHome in {"" "auto"}} {
   1083  1.1  christos     # Check the environment. $EMSDK gets set by sourcing emsdk_env.sh.
   1084  1.1  christos     set emsdkHome [get-env EMSDK ""]
   1085  1.1  christos   }
   1086  1.1  christos   set rc 0
   1087  1.1  christos   if {$emsdkHome ne ""} {
   1088  1.1  christos     define EMSDK_HOME $emsdkHome
   1089  1.1  christos     set emsdkEnv "$emsdkHome/emsdk_env.sh"
   1090  1.1  christos     if {[file exists $emsdkEnv]} {
   1091  1.1  christos       msg-result "$emsdkHome"
   1092  1.1  christos       define EMSDK_ENV_SH $emsdkEnv
   1093  1.1  christos       set rc 1
   1094  1.1  christos       set emcc "$emsdkHome/upstream/emscripten/emcc"
   1095  1.1  christos       if {[file exists $emcc]} {
   1096  1.1  christos         define BIN_EMCC $emcc
   1097  1.1  christos       }
   1098  1.1  christos     } else {
   1099  1.1  christos       msg-result "emsdk_env.sh not found in $emsdkHome"
   1100  1.1  christos     }
   1101  1.1  christos   } else {
   1102  1.1  christos     msg-result "not found"
   1103  1.1  christos   }
   1104  1.1  christos   if {$hadValue && 0 == $rc} {
   1105  1.1  christos     # Fail if it was explicitly requested but not found
   1106  1.1  christos     proj-fatal "Cannot find the Emscripten SDK"
   1107  1.1  christos   }
   1108  1.1  christos   define HAVE_EMSDK $rc
   1109  1.1  christos   return $rc
   1110  1.1  christos }
   1111  1.1  christos 
   1112  1.1  christos #
   1113  1.1  christos # @proj-cc-check-Wl-flag ?flag ?args??
   1114  1.1  christos #
   1115  1.1  christos # Checks whether the given linker flag (and optional arguments) can be
   1116  1.1  christos # passed from the compiler to the linker using one of these formats:
   1117  1.1  christos #
   1118  1.1  christos # - -Wl,flag[,arg1[,...argN]]
   1119  1.1  christos # - -Wl,flag -Wl,arg1 ...-Wl,argN
   1120  1.1  christos #
   1121  1.1  christos # If so, that flag string is returned, else an empty string is
   1122  1.1  christos # returned.
   1123  1.1  christos #
   1124  1.1  christos proc proj-cc-check-Wl-flag {args} {
   1125  1.1  christos   cc-with {-link 1} {
   1126  1.1  christos     # Try -Wl,flag,...args
   1127  1.1  christos     set fli "-Wl"
   1128  1.1  christos     foreach f $args { append fli ",$f" }
   1129  1.1  christos     if {[cc-check-flags $fli]} {
   1130  1.1  christos       return $fli
   1131  1.1  christos     }
   1132  1.1  christos     # Try -Wl,flag -Wl,arg1 ...-Wl,argN
   1133  1.1  christos     set fli ""
   1134  1.1  christos     foreach f $args { append fli "-Wl,$f " }
   1135  1.1  christos     if {[cc-check-flags $fli]} {
   1136  1.1  christos       return [string trim $fli]
   1137  1.1  christos     }
   1138  1.1  christos     return ""
   1139  1.1  christos   }
   1140  1.1  christos }
   1141  1.1  christos 
   1142  1.1  christos #
   1143  1.1  christos # @proj-check-rpath
   1144  1.1  christos #
   1145  1.1  christos # Tries various approaches to handling the -rpath link-time
   1146  1.1  christos # flag. Defines LDFLAGS_RPATH to that/those flag(s) or an empty
   1147  1.1  christos # string. Returns 1 if it finds an option, else 0.
   1148  1.1  christos #
   1149  1.1  christos # By default, the rpath is set to $prefix/lib. However, if either of
   1150  1.1  christos # --exec-prefix=... or --libdir=...  are explicitly passed to
   1151  1.1  christos # configure then [get-define libdir] is used (noting that it derives
   1152  1.1  christos # from exec-prefix by default).
   1153  1.1  christos #
   1154  1.1  christos proc proj-check-rpath {} {
   1155  1.1  christos   if {[proj-opt-was-provided libdir]
   1156  1.1  christos       || [proj-opt-was-provided exec-prefix]} {
   1157  1.1  christos     set lp "[get-define libdir]"
   1158  1.1  christos   } else {
   1159  1.1  christos     set lp "[get-define prefix]/lib"
   1160  1.1  christos   }
   1161  1.1  christos   # If we _don't_ use cc-with {} here (to avoid updating the global
   1162  1.1  christos   # CFLAGS or LIBS or whatever it is that cc-check-flags updates) then
   1163  1.1  christos   # downstream tests may fail because the resulting rpath gets
   1164  1.1  christos   # implicitly injected into them.
   1165  1.1  christos   cc-with {-link 1} {
   1166  1.1  christos     if {[cc-check-flags "-rpath $lp"]} {
   1167  1.1  christos       define LDFLAGS_RPATH "-rpath $lp"
   1168  1.1  christos     } else {
   1169  1.1  christos       set wl [proj-cc-check-Wl-flag -rpath $lp]
   1170  1.1  christos       if {"" eq $wl} {
   1171  1.1  christos         set wl [proj-cc-check-Wl-flag -R$lp]
   1172  1.1  christos       }
   1173  1.1  christos       if {"" eq $wl} {
   1174  1.1  christos         # HP-UX: https://sqlite.org/forum/forumpost/d80ecdaddd
   1175  1.1  christos         set wl [proj-cc-check-Wl-flag +b $lp]
   1176  1.1  christos       }
   1177  1.1  christos       define LDFLAGS_RPATH $wl
   1178  1.1  christos     }
   1179  1.1  christos   }
   1180  1.1  christos   expr {"" ne [get-define LDFLAGS_RPATH]}
   1181  1.1  christos }
   1182  1.1  christos 
   1183  1.1  christos #
   1184  1.1  christos # @proj-check-soname ?libname?
   1185  1.1  christos #
   1186  1.1  christos # Checks whether CC supports the -Wl,-soname,lib... flag. If so, it
   1187  1.1  christos # returns 1 and defines LDFLAGS_SONAME_PREFIX to the flag's prefix, to
   1188  1.1  christos # which the client would need to append "libwhatever.N".  If not, it
   1189  1.1  christos # returns 0 and defines LDFLAGS_SONAME_PREFIX to an empty string.
   1190  1.1  christos #
   1191  1.1  christos # The libname argument is only for purposes of running the flag
   1192  1.1  christos # compatibility test, and is not included in the resulting
   1193  1.1  christos # LDFLAGS_SONAME_PREFIX. It is provided so that clients may
   1194  1.1  christos # potentially avoid some end-user confusion by using their own lib's
   1195  1.1  christos # name here (which shows up in the "checking..." output).
   1196  1.1  christos #
   1197  1.1  christos proc proj-check-soname {{libname "libfoo.so.0"}} {
   1198  1.1  christos   cc-with {-link 1} {
   1199  1.1  christos     if {[cc-check-flags "-Wl,-soname,${libname}"]} {
   1200  1.1  christos       define LDFLAGS_SONAME_PREFIX "-Wl,-soname,"
   1201  1.1  christos       return 1
   1202  1.1  christos     } elseif {[cc-check-flags "-Wl,+h,${libname}"]} {
   1203  1.1  christos       # HP-UX: https://sqlite.org/forum/forumpost/d80ecdaddd
   1204  1.1  christos       define LDFLAGS_SONAME_PREFIX "-Wl,+h,"
   1205  1.1  christos       return 1
   1206  1.1  christos     } else {
   1207  1.1  christos       define LDFLAGS_SONAME_PREFIX ""
   1208  1.1  christos       return 0
   1209  1.1  christos     }
   1210  1.1  christos   }
   1211  1.1  christos }
   1212  1.1  christos 
   1213  1.1  christos #
   1214  1.1  christos # @proj-check-fsanitize ?list-of-opts?
   1215  1.1  christos #
   1216  1.1  christos # Checks whether CC supports -fsanitize=X, where X is each entry of
   1217  1.1  christos # the given list of flags. If any of those flags are supported, it
   1218  1.1  christos # returns the string "-fsanitize=X..." where X... is a comma-separated
   1219  1.1  christos # list of all flags from the original set which are supported. If none
   1220  1.1  christos # of the given options are supported then it returns an empty string.
   1221  1.1  christos #
   1222  1.1  christos # Example:
   1223  1.1  christos #
   1224  1.1  christos #  set f [proj-check-fsanitize {address bounds-check just-testing}]
   1225  1.1  christos #
   1226  1.1  christos # Will, on many systems, resolve to "-fsanitize=address,bounds-check",
   1227  1.1  christos # but may also resolve to "-fsanitize=address".
   1228  1.1  christos #
   1229  1.1  christos proc proj-check-fsanitize {{opts {address bounds-strict}}} {
   1230  1.1  christos   set sup {}
   1231  1.1  christos   foreach opt $opts {
   1232  1.1  christos     # -nooutput is used because -fsanitize=hwaddress will otherwise
   1233  1.1  christos     # pass this test on x86_64, but then warn at build time that
   1234  1.1  christos     # "hwaddress is not supported for this target".
   1235  1.1  christos     cc-with {-nooutput 1} {
   1236  1.1  christos       if {[cc-check-flags "-fsanitize=$opt"]} {
   1237  1.1  christos         lappend sup $opt
   1238  1.1  christos       }
   1239  1.1  christos     }
   1240  1.1  christos   }
   1241  1.1  christos   if {[llength $sup] > 0} {
   1242  1.1  christos     return "-fsanitize=[join $sup ,]"
   1243  1.1  christos   }
   1244  1.1  christos   return ""
   1245  1.1  christos }
   1246  1.1  christos 
   1247  1.1  christos #
   1248  1.1  christos # Internal helper for proj-dump-defs-json. Expects to be passed a
   1249  1.1  christos # [define] name and the variadic $args which are passed to
   1250  1.1  christos # proj-dump-defs-json. If it finds a pattern match for the given
   1251  1.1  christos # $name in the various $args, it returns the type flag for that $name,
   1252  1.1  christos # e.g. "-str" or "-bare", else returns an empty string.
   1253  1.1  christos #
   1254  1.1  christos proc proj-defs-type_ {name spec} {
   1255  1.1  christos   foreach {type patterns} $spec {
   1256  1.1  christos     foreach pattern $patterns {
   1257  1.1  christos       if {[string match $pattern $name]} {
   1258  1.1  christos         return $type
   1259  1.1  christos       }
   1260  1.1  christos     }
   1261  1.1  christos   }
   1262  1.1  christos   return ""
   1263  1.1  christos }
   1264  1.1  christos 
   1265  1.1  christos #
   1266  1.1  christos # Internal helper for proj-defs-format_: returns a JSON-ish quoted
   1267  1.1  christos # form of the given string-type values. It only performs the most
   1268  1.1  christos # basic of escaping. The input must not contain any control
   1269  1.1  christos # characters.
   1270  1.1  christos #
   1271  1.1  christos proc proj-quote-str_ {value} {
   1272  1.1  christos   return \"[string map [list \\ \\\\ \" \\\"] $value]\"
   1273  1.1  christos }
   1274  1.1  christos 
   1275  1.1  christos #
   1276  1.1  christos # An internal impl detail of proj-dump-defs-json. Requires a data
   1277  1.1  christos # type specifier, as used by make-config-header, and a value. Returns
   1278  1.1  christos # the formatted value or the value $::proj__Config(defs-skip) if the caller
   1279  1.1  christos # should skip emitting that value.
   1280  1.1  christos #
   1281  1.1  christos set ::proj__Config(defs-skip) "-proj-defs-format_ sentinel"
   1282  1.1  christos proc proj-defs-format_ {type value} {
   1283  1.1  christos   switch -exact -- $type {
   1284  1.1  christos     -bare {
   1285  1.1  christos       # Just output the value unchanged
   1286  1.1  christos     }
   1287  1.1  christos     -none {
   1288  1.1  christos       set value $::proj__Config(defs-skip)
   1289  1.1  christos     }
   1290  1.1  christos     -str {
   1291  1.1  christos       set value [proj-quote-str_ $value]
   1292  1.1  christos     }
   1293  1.1  christos     -auto {
   1294  1.1  christos       # Automatically determine the type
   1295  1.1  christos       if {![string is integer -strict $value]} {
   1296  1.1  christos         set value [proj-quote-str_ $value]
   1297  1.1  christos       }
   1298  1.1  christos     }
   1299  1.1  christos     -array {
   1300  1.1  christos       set ar {}
   1301  1.1  christos       foreach v $value {
   1302  1.1  christos         set v [proj-defs-format_ -auto $v]
   1303  1.1  christos         if {$::proj__Config(defs-skip) ne $v} {
   1304  1.1  christos           lappend ar $v
   1305  1.1  christos         }
   1306  1.1  christos       }
   1307  1.1  christos       set value "\[ [join $ar {, }] \]"
   1308  1.1  christos     }
   1309  1.1  christos     "" {
   1310  1.1  christos       set value $::proj__Config(defs-skip)
   1311  1.1  christos     }
   1312  1.1  christos     default {
   1313  1.1  christos       proj-fatal "Unknown type in proj-dump-defs-json: $type"
   1314  1.1  christos     }
   1315  1.1  christos   }
   1316  1.1  christos   return $value
   1317  1.1  christos }
   1318  1.1  christos 
   1319  1.1  christos #
   1320  1.1  christos # @proj-dump-defs-json outfile ...flags
   1321  1.1  christos #
   1322  1.1  christos # This function works almost identically to autosetup's
   1323  1.1  christos # make-config-header but emits its output in JSON form. It is not a
   1324  1.1  christos # fully-functional JSON emitter, and will emit broken JSON for
   1325  1.1  christos # complicated outputs, but should be sufficient for purposes of
   1326  1.1  christos # emitting most configure vars (numbers and simple strings).
   1327  1.1  christos #
   1328  1.1  christos # In addition to the formatting flags supported by make-config-header,
   1329  1.1  christos # it also supports:
   1330  1.1  christos #
   1331  1.1  christos #  -array {patterns...}
   1332  1.1  christos #
   1333  1.1  christos # Any defines matching the given patterns will be treated as a list of
   1334  1.1  christos # values, each of which will be formatted as if it were in an -auto {...}
   1335  1.1  christos # set, and the define will be emitted to JSON in the form:
   1336  1.1  christos #
   1337  1.1  christos #  "ITS_NAME": [ "value1", ...valueN ]
   1338  1.1  christos #
   1339  1.1  christos # Achtung: if a given -array pattern contains values which themselves
   1340  1.1  christos # contains spaces...
   1341  1.1  christos #
   1342  1.1  christos #   define-append foo {"-DFOO=bar baz" -DBAR="baz barre"}
   1343  1.1  christos #
   1344  1.1  christos # will lead to:
   1345  1.1  christos #
   1346  1.1  christos #  ["-DFOO=bar baz", "-DBAR=\"baz", "barre\""]
   1347  1.1  christos #
   1348  1.1  christos # Neither is especially satisfactory (and the second is useless), and
   1349  1.1  christos # handling of such values is subject to change if any such values ever
   1350  1.1  christos # _really_ need to be processed by our source trees.
   1351  1.1  christos #
   1352  1.1  christos proc proj-dump-defs-json {file args} {
   1353  1.1  christos   file mkdir [file dirname $file]
   1354  1.1  christos   set lines {}
   1355  1.1  christos   lappend args -bare {SIZEOF_* HAVE_DECL_*} -auto HAVE_*
   1356  1.1  christos   foreach n [lsort [dict keys [all-defines]]] {
   1357  1.1  christos     set type [proj-defs-type_ $n $args]
   1358  1.1  christos     set value [proj-defs-format_ $type [get-define $n]]
   1359  1.1  christos     if {$::proj__Config(defs-skip) ne $value} {
   1360  1.1  christos       lappend lines "\"$n\": ${value}"
   1361  1.1  christos     }
   1362  1.1  christos   }
   1363  1.1  christos   set buf {}
   1364  1.1  christos   lappend buf [join $lines ",\n"]
   1365  1.1  christos   write-if-changed $file $buf {
   1366  1.1  christos     msg-result "Created $file"
   1367  1.1  christos   }
   1368  1.1  christos }
   1369  1.1  christos 
   1370  1.1  christos #
   1371  1.1  christos # @proj-xfer-option-aliases map
   1372  1.1  christos #
   1373  1.1  christos # Expects a list of pairs of configure flags which have been
   1374  1.1  christos # registered with autosetup, in this form:
   1375  1.1  christos #
   1376  1.1  christos #  { alias1 => canonical1
   1377  1.1  christos #    aliasN => canonicalN ... }
   1378  1.1  christos #
   1379  1.1  christos # The names must not have their leading -- part and must be in the
   1380  1.1  christos # form which autosetup will expect for passing to [opt-val NAME] and
   1381  1.1  christos # friends.
   1382  1.1  christos #
   1383  1.1  christos # Comment lines are permitted in the input.
   1384  1.1  christos #
   1385  1.1  christos # For each pair of ALIAS and CANONICAL, if --ALIAS is provided but
   1386  1.1  christos # --CANONICAL is not, the value of the former is copied to the
   1387  1.1  christos # latter. If --ALIAS is not provided, this is a no-op. If both have
   1388  1.1  christos # explicitly been provided a fatal usage error is triggered.
   1389  1.1  christos #
   1390  1.1  christos # Motivation: autosetup enables "hidden aliases" in [options] lists,
   1391  1.1  christos # and elides the aliases from --help output but does no further
   1392  1.1  christos # handling of them. For example, when --alias is a hidden alias of
   1393  1.1  christos # --canonical and a user passes --alias=X, [opt-val canonical] returns
   1394  1.1  christos # no value. i.e. the script must check both [opt-val alias] and
   1395  1.1  christos # [opt-val canonical].  The intent here is that this function be
   1396  1.1  christos # passed such mappings immediately after [options] is called, to carry
   1397  1.1  christos # over any values from hidden aliases into their canonical names, such
   1398  1.1  christos # that [opt-value canonical] will return X if --alias=X is passed to
   1399  1.1  christos # configure.
   1400  1.1  christos #
   1401  1.1  christos # That said: autosetup's [opt-str] does support alias forms, but it
   1402  1.1  christos # requires that the caller know all possible aliases. It's simpler, in
   1403  1.1  christos # terms of options handling, if there's only a single canonical name
   1404  1.1  christos # which each down-stream call of [opt-...] has to know.
   1405  1.1  christos #
   1406  1.1  christos proc proj-xfer-options-aliases {mapping} {
   1407  1.1  christos   foreach {hidden - canonical} [proj-strip-hash-comments $mapping] {
   1408  1.1  christos     if {[proj-opt-was-provided $hidden]} {
   1409  1.1  christos       if {[proj-opt-was-provided $canonical]} {
   1410  1.1  christos         proj-fatal "both --$canonical and its alias --$hidden were used. Use only one or the other."
   1411  1.1  christos       } else {
   1412  1.1  christos         proj-opt-set $canonical [opt-val $hidden]
   1413  1.1  christos       }
   1414  1.1  christos     }
   1415  1.1  christos   }
   1416  1.1  christos }
   1417  1.1  christos 
   1418  1.1  christos #
   1419  1.1  christos # Arguable/debatable...
   1420  1.1  christos #
   1421  1.1  christos # When _not_ cross-compiling and CC_FOR_BUILD is _not_ explicitly
   1422  1.1  christos # specified, force CC_FOR_BUILD to be the same as CC, so that:
   1423  1.1  christos #
   1424  1.1  christos # ./configure CC=clang
   1425  1.1  christos #
   1426  1.1  christos # will use CC_FOR_BUILD=clang, instead of cc, for building in-tree
   1427  1.1  christos # tools. This is based off of an email discussion and is thought to
   1428  1.1  christos # be likely to cause less confusion than seeing 'cc' invocations
   1429  1.1  christos # when when the user passes CC=clang.
   1430  1.1  christos #
   1431  1.1  christos # Sidebar: if we do this before the cc package is installed, it gets
   1432  1.1  christos # reverted by that package. Ergo, the cc package init will tell the
   1433  1.1  christos # user "Build C compiler...cc" shortly before we tell them otherwise.
   1434  1.1  christos #
   1435  1.1  christos proc proj-redefine-cc-for-build {} {
   1436  1.1  christos   if {![proj-is-cross-compiling]
   1437  1.1  christos       && [get-define CC] ne [get-define CC_FOR_BUILD]
   1438  1.1  christos       && "nope" eq [get-env CC_FOR_BUILD "nope"]} {
   1439  1.1  christos     user-notice "Re-defining CC_FOR_BUILD to CC=[get-define CC]. To avoid this, explicitly pass CC_FOR_BUILD=..."
   1440  1.1  christos     define CC_FOR_BUILD [get-define CC]
   1441  1.1  christos   }
   1442  1.1  christos }
   1443  1.1  christos 
   1444  1.1  christos #
   1445  1.1  christos # @proj-which-linenoise headerFile
   1446  1.1  christos #
   1447  1.1  christos # Attempts to determine whether the given linenoise header file is of
   1448  1.1  christos # the "antirez" or "msteveb" flavor. It returns 2 for msteveb, else 1
   1449  1.1  christos # (it does not validate that the header otherwise contains the
   1450  1.1  christos # linenoise API).
   1451  1.1  christos #
   1452  1.1  christos proc proj-which-linenoise {dotH} {
   1453  1.1  christos   set srcHeader [proj-file-content $dotH]
   1454  1.1  christos   if {[string match *userdata* $srcHeader]} {
   1455  1.1  christos     return 2
   1456  1.1  christos   } else {
   1457  1.1  christos     return 1
   1458  1.1  christos   }
   1459  1.1  christos }
   1460  1.1  christos 
   1461  1.1  christos #
   1462  1.1  christos # @proj-remap-autoconf-dir-vars
   1463  1.1  christos #
   1464  1.1  christos # "Re-map" the autoconf-conventional --XYZdir flags into something
   1465  1.1  christos # which is more easily overridable from a make invocation.
   1466  1.1  christos #
   1467  1.1  christos # Based off of notes in <https://sqlite.org/forum/forumpost/00d12a41f7>.
   1468  1.1  christos #
   1469  1.1  christos # Consider:
   1470  1.1  christos #
   1471  1.1  christos # $ ./configure --prefix=/foo
   1472  1.1  christos # $ make install prefix=/blah
   1473  1.1  christos #
   1474  1.1  christos # In that make invocation, $(libdir) would, at make-time, normally be
   1475  1.1  christos # hard-coded to /foo/lib, rather than /blah/lib. That happens because
   1476  1.1  christos # autosetup exports conventional $prefix-based values for the numerous
   1477  1.1  christos # autoconfig-compatible XYZdir vars at configure-time.  What we would
   1478  1.1  christos # normally want, however, is that --libdir derives from the make-time
   1479  1.1  christos # $(prefix).  The distinction between configure-time and make-time is
   1480  1.1  christos # the significant factor there.
   1481  1.1  christos #
   1482  1.1  christos # This function attempts to reconcile those vars in such a way that
   1483  1.1  christos # they will derive, at make-time, from $(prefix) in a conventional
   1484  1.1  christos # manner unless they are explicitly overridden at configure-time, in
   1485  1.1  christos # which case those overrides takes precedence.
   1486  1.1  christos #
   1487  1.1  christos # Each autoconf-relvant --XYZ flag which is explicitly passed to
   1488  1.1  christos # configure is exported as-is, as are those which default to some
   1489  1.1  christos # top-level system directory, e.g. /etc or /var.  All which derive
   1490  1.1  christos # from either $prefix or $exec_prefix are exported in the form of a
   1491  1.1  christos # Makefile var reference, e.g.  libdir=${exec_prefix}/lib. Ergo, if
   1492  1.1  christos # --exec-prefix=FOO is passed to configure, libdir will still derive,
   1493  1.1  christos # at make-time, from whatever exec_prefix is passed to make, and will
   1494  1.1  christos # use FOO if exec_prefix is not overridden at make-time.  Without this
   1495  1.1  christos # post-processing, libdir would be cemented in as FOO/lib at
   1496  1.1  christos # configure-time, so could be tedious to override properly via a make
   1497  1.1  christos # invocation.
   1498  1.1  christos #
   1499  1.1  christos proc proj-remap-autoconf-dir-vars {} {
   1500  1.1  christos   set prefix [get-define prefix]
   1501  1.1  christos   set exec_prefix [get-define exec_prefix $prefix]
   1502  1.1  christos   # The following var derefs must be formulated such that they are
   1503  1.1  christos   # legal for use in (A) makefiles, (B) pkgconfig files, and (C) TCL's
   1504  1.1  christos   # [subst] command.  i.e. they must use the form ${X}.
   1505  1.1  christos   foreach {flag makeVar makeDeref} {
   1506  1.1  christos     exec-prefix     exec_prefix    ${prefix}
   1507  1.1  christos     datadir         datadir        ${prefix}/share
   1508  1.1  christos     mandir          mandir         ${datadir}/man
   1509  1.1  christos     includedir      includedir     ${prefix}/include
   1510  1.1  christos     bindir          bindir         ${exec_prefix}/bin
   1511  1.1  christos     libdir          libdir         ${exec_prefix}/lib
   1512  1.1  christos     sbindir         sbindir        ${exec_prefix}/sbin
   1513  1.1  christos     sysconfdir      sysconfdir     /etc
   1514  1.1  christos     sharedstatedir  sharedstatedir ${prefix}/com
   1515  1.1  christos     localstatedir   localstatedir  /var
   1516  1.1  christos     runstatedir     runstatedir    /run
   1517  1.1  christos     infodir         infodir        ${datadir}/info
   1518  1.1  christos     libexecdir      libexecdir     ${exec_prefix}/libexec
   1519  1.1  christos   } {
   1520  1.1  christos     if {[proj-opt-was-provided $flag]} {
   1521  1.1  christos       define $makeVar [join [opt-val $flag]]
   1522  1.1  christos     } else {
   1523  1.1  christos       define $makeVar [join $makeDeref]
   1524  1.1  christos     }
   1525  1.1  christos     # Maintenance reminder: the [join] call is to avoid {braces}
   1526  1.1  christos     # around the output when someone passes in,
   1527  1.1  christos     # e.g. --libdir=\${prefix}/foo/bar. Debian's SQLite package build
   1528  1.1  christos     # script does that.
   1529  1.1  christos   }
   1530  1.1  christos }
   1531  1.1  christos 
   1532  1.1  christos #
   1533  1.1  christos # @proj-env-file flag ?default?
   1534  1.1  christos #
   1535  1.1  christos # If a file named .env-$flag exists, this function returns a
   1536  1.1  christos # trimmed copy of its contents, else it returns $dflt. The intended
   1537  1.1  christos # usage is that things like developer-specific CFLAGS preferences can
   1538  1.1  christos # be stored in .env-CFLAGS.
   1539  1.1  christos #
   1540  1.1  christos proc proj-env-file {flag {dflt ""}} {
   1541  1.1  christos   set fn ".env-${flag}"
   1542  1.1  christos   if {[file readable $fn]} {
   1543  1.1  christos     return [proj-file-content -trim $fn]
   1544  1.1  christos   }
   1545  1.1  christos   return $dflt
   1546  1.1  christos }
   1547  1.1  christos 
   1548  1.1  christos #
   1549  1.1  christos # @proj-get-env var ?default?
   1550  1.1  christos #
   1551  1.1  christos # Extracts the value of "environment" variable $var from the first of
   1552  1.1  christos # the following places where it's defined:
   1553  1.1  christos #
   1554  1.1  christos # - Passed to configure as $var=...
   1555  1.1  christos # - Exists as an environment variable
   1556  1.1  christos # - A file named .env-$var (see [proj-env-file])
   1557  1.1  christos #
   1558  1.1  christos # If none of those are set, $dflt is returned.
   1559  1.1  christos #
   1560  1.1  christos proc proj-get-env {var {dflt ""}} {
   1561  1.1  christos   get-env $var [proj-env-file $var $dflt]
   1562  1.1  christos }
   1563  1.1  christos 
   1564  1.1  christos #
   1565  1.1  christos # @proj-scope ?lvl?
   1566  1.1  christos #
   1567  1.1  christos # Returns the name of the _calling_ proc from ($lvl + 1) levels up the
   1568  1.1  christos # call stack (where the caller's level will be 1 up from _this_
   1569  1.1  christos # call). If $lvl would resolve to global scope "global scope" is
   1570  1.1  christos # returned and if it would be negative then a string indicating such
   1571  1.1  christos # is returned (as opposed to throwing an error).
   1572  1.1  christos #
   1573  1.1  christos proc proj-scope {{lvl 0}} {
   1574  1.1  christos   #uplevel [expr {$lvl + 1}] {lindex [info level 0] 0}
   1575  1.1  christos   set ilvl [info level]
   1576  1.1  christos   set offset [expr {$ilvl  - $lvl - 1}]
   1577  1.1  christos   if { $offset < 0} {
   1578  1.1  christos     return "invalid scope ($offset)"
   1579  1.1  christos   } elseif { $offset == 0} {
   1580  1.1  christos     return "global scope"
   1581  1.1  christos   } else {
   1582  1.1  christos     return [lindex [info level $offset] 0]
   1583  1.1  christos   }
   1584  1.1  christos }
   1585  1.1  christos 
   1586  1.1  christos #
   1587  1.1  christos # Deprecated name of [proj-scope].
   1588  1.1  christos #
   1589  1.1  christos proc proj-current-scope {{lvl 0}} {
   1590  1.1  christos   puts stderr \
   1591  1.1  christos     "Deprecated proj-current-scope called from [proj-scope 1]. Use proj-scope instead."
   1592  1.1  christos   proj-scope [incr lvl]
   1593  1.1  christos }
   1594  1.1  christos 
   1595  1.1  christos #
   1596  1.1  christos # Converts parts of tclConfig.sh to autosetup [define]s.
   1597  1.1  christos #
   1598  1.1  christos # Expects to be passed the name of a value tclConfig.sh or an empty
   1599  1.1  christos # string.  It converts certain parts of that file's contents to
   1600  1.1  christos # [define]s (see the code for the whole list). If $tclConfigSh is an
   1601  1.1  christos # empty string then it [define]s the various vars as empty strings.
   1602  1.1  christos #
   1603  1.1  christos proc proj-tclConfig-sh-to-autosetup {tclConfigSh} {
   1604  1.1  christos   set shBody {}
   1605  1.1  christos   set tclVars {
   1606  1.1  christos     TCL_INCLUDE_SPEC
   1607  1.1  christos     TCL_LIBS
   1608  1.1  christos     TCL_LIB_SPEC
   1609  1.1  christos     TCL_STUB_LIB_SPEC
   1610  1.1  christos     TCL_EXEC_PREFIX
   1611  1.1  christos     TCL_PREFIX
   1612  1.1  christos     TCL_VERSION
   1613  1.1  christos     TCL_MAJOR_VERSION
   1614  1.1  christos     TCL_MINOR_VERSION
   1615  1.1  christos     TCL_PACKAGE_PATH
   1616  1.1  christos     TCL_PATCH_LEVEL
   1617  1.1  christos     TCL_SHLIB_SUFFIX
   1618  1.1  christos   }
   1619  1.1  christos   # Build a small shell script which proxies the $tclVars from
   1620  1.1  christos   # $tclConfigSh into autosetup code...
   1621  1.1  christos   lappend shBody "if test x = \"x${tclConfigSh}\"; then"
   1622  1.1  christos   foreach v $tclVars {
   1623  1.1  christos     lappend shBody "$v= ;"
   1624  1.1  christos   }
   1625  1.1  christos   lappend shBody "else . \"${tclConfigSh}\"; fi"
   1626  1.1  christos   foreach v $tclVars {
   1627  1.1  christos     lappend shBody "echo define $v {\$$v} ;"
   1628  1.1  christos   }
   1629  1.1  christos   lappend shBody "exit"
   1630  1.1  christos   set shBody [join $shBody "\n"]
   1631  1.1  christos   #puts "shBody=$shBody\n"; exit
   1632  1.1  christos   eval [exec echo $shBody | sh]
   1633  1.1  christos }
   1634  1.1  christos 
   1635  1.1  christos #
   1636  1.1  christos # @proj-tweak-default-env-dirs
   1637  1.1  christos #
   1638  1.1  christos # This function is not useful before [use system] is called to set up
   1639  1.1  christos # --prefix and friends. It should be called as soon after [use system]
   1640  1.1  christos # as feasible.
   1641  1.1  christos #
   1642  1.1  christos # For certain target environments, if --prefix is _not_ passed in by
   1643  1.1  christos # the user, set the prefix to an environment-specific default. For
   1644  1.1  christos # such environments its does [define prefix ...]  and [proj-opt-set
   1645  1.1  christos # prefix ...], but it does not process vars derived from the prefix,
   1646  1.1  christos # e.g. exec-prefix. To do so it is generally necessary to also call
   1647  1.1  christos # proj-remap-autoconf-dir-vars late in the config process (immediately
   1648  1.1  christos # before ".in" files are filtered).
   1649  1.1  christos #
   1650  1.1  christos # Similar modifications may be made for --mandir.
   1651  1.1  christos #
   1652  1.1  christos # Returns >0 if it modifies the environment, else 0.
   1653  1.1  christos #
   1654  1.1  christos proc proj-tweak-default-env-dirs {} {
   1655  1.1  christos   set rc 0
   1656  1.1  christos   switch -glob -- [get-define host] {
   1657  1.1  christos     *-haiku {
   1658  1.1  christos       if {![proj-opt-was-provided prefix]} {
   1659  1.1  christos         set hdir /boot/home/config/non-packaged
   1660  1.1  christos         proj-opt-set prefix $hdir
   1661  1.1  christos         define prefix $hdir
   1662  1.1  christos         incr rc
   1663  1.1  christos       }
   1664  1.1  christos       if {![proj-opt-was-provided mandir]} {
   1665  1.1  christos         set hdir /boot/system/documentation/man
   1666  1.1  christos         proj-opt-set mandir $hdir
   1667  1.1  christos         define mandir $hdir
   1668  1.1  christos         incr rc
   1669  1.1  christos       }
   1670  1.1  christos     }
   1671  1.1  christos   }
   1672  1.1  christos   return $rc
   1673  1.1  christos }
   1674  1.1  christos 
   1675  1.1  christos #
   1676  1.1  christos # @proj-dot-ins-append file ?fileOut ?postProcessScript??
   1677  1.1  christos #
   1678  1.1  christos # Queues up an autosetup [make-template]-style file to be processed
   1679  1.1  christos # at a later time using [proj-dot-ins-process].
   1680  1.1  christos #
   1681  1.1  christos # $file is the input file. If $fileOut is empty then this function
   1682  1.1  christos # derives $fileOut from $file, stripping both its directory and
   1683  1.1  christos # extension parts. i.e. it defaults to writing the output to the
   1684  1.1  christos # current directory (typically $::autosetup(builddir)).
   1685  1.1  christos #
   1686  1.1  christos # If $postProcessScript is not empty then, during
   1687  1.1  christos # [proj-dot-ins-process], it will be eval'd immediately after
   1688  1.1  christos # processing the file. In the context of that script, the vars
   1689  1.1  christos # $dotInsIn and $dotInsOut will be set to the input and output file
   1690  1.1  christos # names.  This can be used, for example, to make the output file
   1691  1.1  christos # executable or perform validation on its contents:
   1692  1.1  christos #
   1693  1.1  christos ##  proj-dot-ins-append my.sh.in my.sh {
   1694  1.1  christos ##    catch {exec chmod u+x $dotInsOut}
   1695  1.1  christos ##  }
   1696  1.1  christos #
   1697  1.1  christos # See [proj-dot-ins-process], [proj-dot-ins-list]
   1698  1.1  christos #
   1699  1.1  christos proc proj-dot-ins-append {fileIn args} {
   1700  1.1  christos   set srcdir $::autosetup(srcdir)
   1701  1.1  christos   switch -exact -- [llength $args] {
   1702  1.1  christos     0 {
   1703  1.1  christos       lappend fileIn [file rootname [file tail $fileIn]] ""
   1704  1.1  christos     }
   1705  1.1  christos     1 {
   1706  1.1  christos       lappend fileIn [join $args] ""
   1707  1.1  christos     }
   1708  1.1  christos     2 {
   1709  1.1  christos       lappend fileIn {*}$args
   1710  1.1  christos     }
   1711  1.1  christos     default {
   1712  1.1  christos       proj-fatal "Too many arguments: $fileIn $args"
   1713  1.1  christos     }
   1714  1.1  christos   }
   1715  1.1  christos   #puts "******* [proj-scope]: adding [llength $fileIn]-length item: $fileIn"
   1716  1.1  christos   lappend ::proj__Config(dot-in-files) $fileIn
   1717  1.1  christos }
   1718  1.1  christos 
   1719  1.1  christos #
   1720  1.1  christos # @proj-dot-ins-list
   1721  1.1  christos #
   1722  1.1  christos # Returns the current list of [proj-dot-ins-append]'d files, noting
   1723  1.1  christos # that each entry is a 3-element list of (inputFileName,
   1724  1.1  christos # outputFileName, postProcessScript).
   1725  1.1  christos #
   1726  1.1  christos proc proj-dot-ins-list {} {
   1727  1.1  christos   return $::proj__Config(dot-in-files)
   1728  1.1  christos }
   1729  1.1  christos 
   1730  1.1  christos #
   1731  1.1  christos # @proj-dot-ins-process ?-touch? ?-validate? ?-clear?
   1732  1.1  christos #
   1733  1.1  christos # Each file which has previously been passed to [proj-dot-ins-append]
   1734  1.1  christos # is processed, with its passing its in-file out-file names to
   1735  1.1  christos # [proj-make-from-dot-in].
   1736  1.1  christos #
   1737  1.1  christos # The intent is that a project accumulate any number of files to
   1738  1.1  christos # filter and delay their actual filtering until the last stage of the
   1739  1.1  christos # configure script, calling this function at that time.
   1740  1.1  christos #
   1741  1.1  christos # Optional flags:
   1742  1.1  christos #
   1743  1.1  christos # -touch: gets passed on to [proj-make-from-dot-in]
   1744  1.1  christos #
   1745  1.1  christos # -validate: after processing each file, before running the file's
   1746  1.1  christos #  associated script, if any, it runs the file through
   1747  1.1  christos #  proj-validate-no-unresolved-ats, erroring out if that does.
   1748  1.1  christos #
   1749  1.1  christos # -clear: after processing, empty the dot-ins list. This effectively
   1750  1.1  christos #  makes proj-dot-ins-append available for re-use.
   1751  1.1  christos #
   1752  1.1  christos proc proj-dot-ins-process {args} {
   1753  1.1  christos   proj-parse-flags args flags {
   1754  1.1  christos     -touch   "" {return "-touch"}
   1755  1.1  christos     -clear    0 {expr 1}
   1756  1.1  christos     -validate 0 {expr 1}
   1757  1.1  christos   }
   1758  1.1  christos   #puts "args=$args"; parray flags
   1759  1.1  christos   if {[llength $args] > 0} {
   1760  1.1  christos     error "Invalid argument to [proj-scope]: $args"
   1761  1.1  christos   }
   1762  1.1  christos   foreach f $::proj__Config(dot-in-files) {
   1763  1.1  christos     proj-assert {3==[llength $f]} \
   1764  1.1  christos       "Expecting proj-dot-ins-list to be stored in 3-entry lists. Got: $f"
   1765  1.1  christos     lassign $f fIn fOut fScript
   1766  1.1  christos     #puts "DOING $fIn  ==> $fOut"
   1767  1.1  christos     proj-make-from-dot-in {*}$flags(-touch) $fIn $fOut
   1768  1.1  christos     if {$flags(-validate)} {
   1769  1.1  christos       proj-validate-no-unresolved-ats $fOut
   1770  1.1  christos     }
   1771  1.1  christos     if {"" ne $fScript} {
   1772  1.1  christos       uplevel 1 [join [list set dotInsIn $fIn \; \
   1773  1.1  christos                          set dotInsOut $fOut \; \
   1774  1.1  christos                          eval \{${fScript}\} \; \
   1775  1.1  christos                          unset dotInsIn dotInsOut]]
   1776  1.1  christos     }
   1777  1.1  christos   }
   1778  1.1  christos   if {$flags(-clear)} {
   1779  1.1  christos     set ::proj__Config(dot-in-files) [list]
   1780  1.1  christos   }
   1781  1.1  christos }
   1782  1.1  christos 
   1783  1.1  christos #
   1784  1.1  christos # @proj-validate-no-unresolved-ats filenames...
   1785  1.1  christos #
   1786  1.1  christos # For each filename given to it, it validates that the file has no
   1787  1.1  christos # unresolved @VAR@ references. If it finds any, it produces an error
   1788  1.1  christos # with location information.
   1789  1.1  christos #
   1790  1.1  christos # Exception: if a filename matches the pattern {*[Mm]ake*} AND a given
   1791  1.1  christos # line begins with a # (not including leading whitespace) then that
   1792  1.1  christos # line is ignored for purposes of this validation. The intent is that
   1793  1.1  christos # @VAR@ inside of makefile comments should not (necessarily) cause
   1794  1.1  christos # validation to fail, as it's sometimes convenient to comment out
   1795  1.1  christos # sections during development of a configure script and its
   1796  1.1  christos # corresponding makefile(s).
   1797  1.1  christos #
   1798  1.1  christos proc proj-validate-no-unresolved-ats {args} {
   1799  1.1  christos   foreach f $args {
   1800  1.1  christos     set lnno 1
   1801  1.1  christos     set isMake [string match {*[Mm]ake*} $f]
   1802  1.1  christos     foreach line [proj-file-content-list $f] {
   1803  1.1  christos       if {!$isMake || ![string match "#*" [string trimleft $line]]} {
   1804  1.1  christos         if {[regexp {(@[A-Za-z0-9_\.]+@)} $line match]} {
   1805  1.1  christos           error "Unresolved reference to $match at line $lnno of $f"
   1806  1.1  christos         }
   1807  1.1  christos       }
   1808  1.1  christos       incr lnno
   1809  1.1  christos     }
   1810  1.1  christos   }
   1811  1.1  christos }
   1812  1.1  christos 
   1813  1.1  christos #
   1814  1.1  christos # @proj-first-file-found tgtVar fileList
   1815  1.1  christos #
   1816  1.1  christos # Searches $fileList for an existing file. If one is found, its name
   1817  1.1  christos # is assigned to tgtVar and 1 is returned, else tgtVar is set to ""
   1818  1.1  christos # and 0 is returned.
   1819  1.1  christos #
   1820  1.1  christos proc proj-first-file-found {tgtVar fileList} {
   1821  1.1  christos   upvar $tgtVar tgt
   1822  1.1  christos   foreach f $fileList {
   1823  1.1  christos     if {[file exists $f]} {
   1824  1.1  christos       set tgt $f
   1825  1.1  christos       return 1
   1826  1.1  christos     }
   1827  1.1  christos   }
   1828  1.1  christos   set tgt ""
   1829  1.1  christos   return 0
   1830  1.1  christos }
   1831  1.1  christos 
   1832  1.1  christos #
   1833  1.1  christos # Defines $defName to contain makefile recipe commands for re-running
   1834  1.1  christos # the configure script with its current set of $::argv flags.  This
   1835  1.1  christos # can be used to automatically reconfigure.
   1836  1.1  christos #
   1837  1.1  christos proc proj-setup-autoreconfig {defName} {
   1838  1.1  christos   define $defName \
   1839  1.1  christos     [join [list \
   1840  1.1  christos              cd \"$::autosetup(builddir)\" \
   1841  1.1  christos              && [get-define AUTOREMAKE "error - missing @AUTOREMAKE@"]]]
   1842  1.1  christos }
   1843  1.1  christos 
   1844  1.1  christos #
   1845  1.1  christos # @prop-define-append defineName args...
   1846  1.1  christos #
   1847  1.1  christos # A proxy for Autosetup's [define-append]. Appends all non-empty $args
   1848  1.1  christos # to [define-append $defineName].
   1849  1.1  christos #
   1850  1.1  christos proc proj-define-append {defineName args} {
   1851  1.1  christos   foreach a $args {
   1852  1.1  christos     if {"" ne $a} {
   1853  1.1  christos       define-append $defineName {*}$a
   1854  1.1  christos     }
   1855  1.1  christos   }
   1856  1.1  christos }
   1857  1.1  christos 
   1858  1.1  christos #
   1859  1.1  christos # @prod-define-amend ?-p|-prepend? ?-d|-define? defineName args...
   1860  1.1  christos #
   1861  1.1  christos # A proxy for Autosetup's [define-append].
   1862  1.1  christos #
   1863  1.1  christos # Appends all non-empty $args to the define named by $defineName.  If
   1864  1.1  christos # one of (-p | -prepend) are used it instead prepends them, in their
   1865  1.1  christos # given order, to $defineName.
   1866  1.1  christos #
   1867  1.1  christos # If -define is used then each argument is assumed to be a [define]'d
   1868  1.1  christos # flag and [get-define X ""] is used to fetch it.
   1869  1.1  christos #
   1870  1.1  christos # Re. linker flags: typically, -lXYZ flags need to be in "reverse"
   1871  1.1  christos # order, with each -lY resolving symbols for -lX's to its left. This
   1872  1.1  christos # order is largely historical, and not relevant on all environments,
   1873  1.1  christos # but it is technically correct and still relevant on some
   1874  1.1  christos # environments.
   1875  1.1  christos #
   1876  1.1  christos # See: proj-define-append
   1877  1.1  christos #
   1878  1.1  christos proc proj-define-amend {args} {
   1879  1.1  christos   set defName ""
   1880  1.1  christos   set prepend 0
   1881  1.1  christos   set isdefs 0
   1882  1.1  christos   set xargs [list]
   1883  1.1  christos   foreach arg $args {
   1884  1.1  christos     switch -exact -- $arg {
   1885  1.1  christos       "" {}
   1886  1.1  christos       -p - -prepend { incr prepend }
   1887  1.1  christos       -d - -define  { incr isdefs }
   1888  1.1  christos       default {
   1889  1.1  christos         if {"" eq $defName} {
   1890  1.1  christos           set defName $arg
   1891  1.1  christos         } else {
   1892  1.1  christos           lappend xargs $arg
   1893  1.1  christos         }
   1894  1.1  christos       }
   1895  1.1  christos     }
   1896  1.1  christos   }
   1897  1.1  christos   if {"" eq $defName} {
   1898  1.1  christos     proj-error "Missing defineName argument in call from [proj-scope 1]"
   1899  1.1  christos   }
   1900  1.1  christos   if {$isdefs} {
   1901  1.1  christos     set args $xargs
   1902  1.1  christos     set xargs [list]
   1903  1.1  christos     foreach arg $args {
   1904  1.1  christos       lappend xargs [get-define $arg ""]
   1905  1.1  christos     }
   1906  1.1  christos     set args $xargs
   1907  1.1  christos   }
   1908  1.1  christos #  puts "**** args=$args"
   1909  1.1  christos #  puts "**** xargs=$xargs"
   1910  1.1  christos 
   1911  1.1  christos   set args $xargs
   1912  1.1  christos   if {$prepend} {
   1913  1.1  christos     lappend args {*}[get-define $defName ""]
   1914  1.1  christos     define $defName [join $args]; # join to eliminate {} entries
   1915  1.1  christos   } else {
   1916  1.1  christos     proj-define-append $defName {*}$args
   1917  1.1  christos   }
   1918  1.1  christos }
   1919  1.1  christos 
   1920  1.1  christos #
   1921  1.1  christos # @proj-define-to-cflag ?-list? ?-quote? ?-zero-undef? defineName...
   1922  1.1  christos #
   1923  1.1  christos # Treat each argument as the name of a [define] and renders it like a
   1924  1.1  christos # CFLAGS value in one of the following forms:
   1925  1.1  christos #
   1926  1.1  christos #  -D$name
   1927  1.1  christos #  -D$name=integer   (strict integer matches only)
   1928  1.1  christos #  '-D$name=value'   (without -quote)
   1929  1.1  christos #  '-D$name="value"' (with -quote)
   1930  1.1  christos #
   1931  1.1  christos # It treats integers as numbers and everything else as a quoted
   1932  1.1  christos # string, noting that it does not handle strings which themselves
   1933  1.1  christos # contain quotes.
   1934  1.1  christos #
   1935  1.1  christos # The -zero-undef flag causes no -D to be emitted for integer values
   1936  1.1  christos # of 0.
   1937  1.1  christos #
   1938  1.1  christos # By default it returns the result as string of all -D... flags,
   1939  1.1  christos # but if passed the -list flag it will return a list of the
   1940  1.1  christos # individual CFLAGS.
   1941  1.1  christos #
   1942  1.1  christos proc proj-define-to-cflag {args} {
   1943  1.1  christos   set rv {}
   1944  1.1  christos   proj-parse-flags args flags {
   1945  1.1  christos     -list       0 {expr 1}
   1946  1.1  christos     -quote      0 {expr 1}
   1947  1.1  christos     -zero-undef 0 {expr 1}
   1948  1.1  christos   }
   1949  1.1  christos   foreach d $args {
   1950  1.1  christos     set v [get-define $d ""]
   1951  1.1  christos     set li {}
   1952  1.1  christos     if {"" eq $d} {
   1953  1.1  christos       set v "-D${d}"
   1954  1.1  christos     } elseif {[string is integer -strict $v]} {
   1955  1.1  christos       if {!$flags(-zero-undef) || $v ne "0"} {
   1956  1.1  christos         set v "-D${d}=$v"
   1957  1.1  christos       }
   1958  1.1  christos     } elseif {$flags(-quote)} {
   1959  1.1  christos       set v "'-D${d}=\"$v\"'"
   1960  1.1  christos     } else {
   1961  1.1  christos       set v "'-D${d}=$v'"
   1962  1.1  christos     }
   1963  1.1  christos     lappend rv $v
   1964  1.1  christos   }
   1965  1.1  christos   expr {$flags(-list) ? $rv : [join $rv]}
   1966  1.1  christos }
   1967  1.1  christos 
   1968  1.1  christos 
   1969  1.1  christos if {0} {
   1970  1.1  christos   # Turns out that autosetup's [options-add] essentially does exactly
   1971  1.1  christos   # this...
   1972  1.1  christos 
   1973  1.1  christos   # A list of lists of Autosetup [options]-format --flags definitions.
   1974  1.1  christos   # Append to this using [proj-options-add] and use
   1975  1.1  christos   # [proj-options-combine] to merge them into a single list for passing
   1976  1.1  christos   # to [options].
   1977  1.1  christos   #
   1978  1.1  christos   set ::proj__Config(extra-options) {}
   1979  1.1  christos 
   1980  1.1  christos   # @proj-options-add list
   1981  1.1  christos   #
   1982  1.1  christos   # Adds a list of options to the pending --flag processing.  It must be
   1983  1.1  christos   # in the format used by Autosetup's [options] function.
   1984  1.1  christos   #
   1985  1.1  christos   # This will have no useful effect if called from after [options]
   1986  1.1  christos   # is called.
   1987  1.1  christos   #
   1988  1.1  christos   # Use [proj-options-combine] to get a combined list of all added
   1989  1.1  christos   # options.
   1990  1.1  christos   #
   1991  1.1  christos   # PS: when writing this i wasn't aware of autosetup's [options-add],
   1992  1.1  christos   # works quite similarly. Only the timing is different.
   1993  1.1  christos   proc proj-options-add {list} {
   1994  1.1  christos     lappend ::proj__Config(extra-options) $list
   1995  1.1  christos   }
   1996  1.1  christos 
   1997  1.1  christos   # @proj-options-combine list1 ?...listN?
   1998  1.1  christos   #
   1999  1.1  christos   # Expects each argument to be a list of options compatible with
   2000  1.1  christos   # autosetup's [options] function. This function concatenates the
   2001  1.1  christos   # contents of each list into a new top-level list, stripping the outer
   2002  1.1  christos   # list part of each argument, and returning that list
   2003  1.1  christos   #
   2004  1.1  christos   # If passed no arguments, it uses the list generated by calls to
   2005  1.1  christos   # [proj-options-add].
   2006  1.1  christos   proc proj-options-combine {args} {
   2007  1.1  christos     set rv [list]
   2008  1.1  christos     if {0 == [llength $args]} {
   2009  1.1  christos       set args $::proj__Config(extra-options)
   2010  1.1  christos     }
   2011  1.1  christos     foreach e $args {
   2012  1.1  christos       lappend rv {*}$e
   2013  1.1  christos     }
   2014  1.1  christos     return $rv
   2015  1.1  christos   }
   2016  1.1  christos }; # proj-options-*
   2017  1.1  christos 
   2018  1.1  christos # Internal cache for use via proj-cache-*.
   2019  1.1  christos array set proj__Cache {}
   2020  1.1  christos 
   2021  1.1  christos #
   2022  1.1  christos # @proj-cache-key arg {addLevel 0}
   2023  1.1  christos #
   2024  1.1  christos # Helper to generate cache keys for [proj-cache-*].
   2025  1.1  christos #
   2026  1.1  christos # $addLevel should almost always be 0.
   2027  1.1  christos #
   2028  1.1  christos # Returns a cache key for the given argument:
   2029  1.1  christos #
   2030  1.1  christos #   integer: relative call stack levels to get the scope name of for
   2031  1.1  christos #   use as a key. [proj-scope [expr {1 + $arg + addLevel}]] is
   2032  1.1  christos #   then used to generate the key. i.e. the default of 0 uses the
   2033  1.1  christos #   calling scope's name as the key.
   2034  1.1  christos #
   2035  1.1  christos #   Anything else: returned as-is
   2036  1.1  christos #
   2037  1.1  christos proc proj-cache-key {arg {addLevel 0}} {
   2038  1.1  christos   if {[string is integer -strict $arg]} {
   2039  1.1  christos     return [proj-scope [expr {$arg + $addLevel + 1}]]
   2040  1.1  christos   }
   2041  1.1  christos   return $arg
   2042  1.1  christos }
   2043  1.1  christos 
   2044  1.1  christos #
   2045  1.1  christos # @proj-cache-set ?-key KEY? ?-level 0? value
   2046  1.1  christos #
   2047  1.1  christos # Sets a feature-check cache entry with the given key.
   2048  1.1  christos #
   2049  1.1  christos # See proj-cache-key for -key's and -level's semantics, noting that
   2050  1.1  christos # this function adds one to -level for purposes of that call.
   2051  1.1  christos proc proj-cache-set {args} {
   2052  1.1  christos   proj-parse-flags args flags {
   2053  1.1  christos     -key => 0
   2054  1.1  christos     -level => 0
   2055  1.1  christos   }
   2056  1.1  christos   lassign $args val
   2057  1.1  christos   set key [proj-cache-key $flags(-key) [expr {1 + $flags(-level)}]]
   2058  1.1  christos   #puts "** fcheck set $key = $val"
   2059  1.1  christos   set ::proj__Cache($key) $val
   2060  1.1  christos }
   2061  1.1  christos 
   2062  1.1  christos #
   2063  1.1  christos # @proj-cache-remove ?key? ?addLevel?
   2064  1.1  christos #
   2065  1.1  christos # Removes an entry from the proj-cache.
   2066  1.1  christos proc proj-cache-remove {{key 0} {addLevel 0}} {
   2067  1.1  christos   set key [proj-cache-key $key [expr {1 + $addLevel}]]
   2068  1.1  christos   set rv ""
   2069  1.1  christos   if {[info exists ::proj__Cache($key)]} {
   2070  1.1  christos     set rv $::proj__Cache($key)
   2071  1.1  christos     unset ::proj__Cache($key)
   2072  1.1  christos   }
   2073  1.1  christos   return $rv;
   2074  1.1  christos }
   2075  1.1  christos 
   2076  1.1  christos #
   2077  1.1  christos # @proj-cache-check ?-key KEY? ?-level LEVEL? tgtVarName
   2078  1.1  christos #
   2079  1.1  christos # Checks for a feature-check cache entry with the given key.
   2080  1.1  christos #
   2081  1.1  christos # If the feature-check cache has a matching entry then this function
   2082  1.1  christos # assigns its value to tgtVar and returns 1, else it assigns tgtVar to
   2083  1.1  christos # "" and returns 0.
   2084  1.1  christos #
   2085  1.1  christos # See proj-cache-key for $key's and $addLevel's semantics, noting that
   2086  1.1  christos # this function adds one to $addLevel for purposes of that call.
   2087  1.1  christos proc proj-cache-check {args} {
   2088  1.1  christos   proj-parse-flags args flags {
   2089  1.1  christos     -key => 0
   2090  1.1  christos     -level => 0
   2091  1.1  christos   }
   2092  1.1  christos   lassign $args tgtVar
   2093  1.1  christos   upvar $tgtVar tgt
   2094  1.1  christos   set rc 0
   2095  1.1  christos   set key [proj-cache-key $flags(-key) [expr {1 + $flags(-level)}]]
   2096  1.1  christos   #puts "** fcheck get key=$key"
   2097  1.1  christos   if {[info exists ::proj__Cache($key)]} {
   2098  1.1  christos     set tgt $::proj__Cache($key)
   2099  1.1  christos     incr rc
   2100  1.1  christos   } else {
   2101  1.1  christos     set tgt ""
   2102  1.1  christos   }
   2103  1.1  christos   return $rc
   2104  1.1  christos }
   2105  1.1  christos 
   2106  1.1  christos #
   2107  1.1  christos # @proj-coalesce ...args
   2108  1.1  christos #
   2109  1.1  christos # Returns the first argument which is not empty (eq ""), or an empty
   2110  1.1  christos # string on no match.
   2111  1.1  christos proc proj-coalesce {args} {
   2112  1.1  christos   foreach arg $args {
   2113  1.1  christos     if {"" ne $arg} {
   2114  1.1  christos       return $arg
   2115  1.1  christos     }
   2116  1.1  christos   }
   2117  1.1  christos   return ""
   2118  1.1  christos }
   2119  1.1  christos 
   2120  1.1  christos #
   2121  1.1  christos # @proj-parse-flags argvListName targetArrayName {prototype}
   2122  1.1  christos #
   2123  1.1  christos # A helper to parse flags from proc argument lists.
   2124  1.1  christos #
   2125  1.1  christos # The first argument is the name of a var holding the args to
   2126  1.1  christos # parse. It will be overwritten, possibly with a smaller list.
   2127  1.1  christos #
   2128  1.1  christos # The second argument is the name of an array variable to create in
   2129  1.1  christos # the caller's scope.
   2130  1.1  christos #
   2131  1.1  christos # The third argument, $prototype, is a description of how to handle
   2132  1.1  christos # the flags. Each entry in that list must be in one of the
   2133  1.1  christos # following forms:
   2134  1.1  christos #
   2135  1.1  christos #   -flag  defaultValue ?-literal|-call|-apply?
   2136  1.1  christos #                       script|number|incr|proc-name|{apply $aLambda}
   2137  1.1  christos #
   2138  1.1  christos #   -flag* ...as above...
   2139  1.1  christos #
   2140  1.1  christos #   -flag  => defaultValue ?-call proc-name-and-args|-apply lambdaExpr?
   2141  1.1  christos #
   2142  1.1  christos #   -flag* => ...as above...
   2143  1.1  christos #
   2144  1.1  christos #   :PRAGMA
   2145  1.1  christos #
   2146  1.1  christos # The first two forms represents a basic flag with no associated
   2147  1.1  christos # following argument. The third and fourth forms, called arg-consuming
   2148  1.1  christos # flags, extract the value from the following argument in $argvName
   2149  1.1  christos # (pneumonic: => points to the next argument.). The :PRAGMA form
   2150  1.1  christos # offers a way to configure certain aspects of this call.
   2151  1.1  christos #
   2152  1.1  christos # If $argv contains any given flag from $prototype, its default value
   2153  1.1  christos # is overridden depending on several factors:
   2154  1.1  christos #
   2155  1.1  christos #  - If the -literal flag is used, or the flag's script is a number,
   2156  1.1  christos #    value is used verbatim.
   2157  1.1  christos #
   2158  1.1  christos #  - Else if the -call flag is used, the argument must be a proc name
   2159  1.1  christos #    and any leading arguments, e.g. {apply $myLambda}.  The proc is passed
   2160  1.1  christos #    the (flag, value) as arguments (non-consuming flags will get
   2161  1.1  christos #    passed the flag's current/starting value and consuming flags will
   2162  1.1  christos #    get the next argument).  Its result becomes the result of the
   2163  1.1  christos #    flag.
   2164  1.1  christos #
   2165  1.1  christos #  - Else if -apply X is used, it's effectively shorthand for -call
   2166  1.1  christos #    {apply X}. Its argument may either be a $lambaRef or a {{f v}
   2167  1.1  christos #    {body}} construct.
   2168  1.1  christos #
   2169  1.1  christos #  - Else if $script is one of the following values, it is treated as
   2170  1.1  christos #    the result of...
   2171  1.1  christos #
   2172  1.1  christos #    - incr: increments the current value of the flag.
   2173  1.1  christos #
   2174  1.1  christos #  - Else $script is eval'd to get its result value. That result
   2175  1.1  christos #    becomes the new flag value for $tgtArrayName(-flag). This
   2176  1.1  christos #    function intercepts [return $val] from eval'ing $script.  Any
   2177  1.1  christos #    empty script will result in the flag having "" assigned to it.
   2178  1.1  christos #
   2179  1.1  christos # Unless the -flag has a trailing asterisk, e.g. -flag*, this function
   2180  1.1  christos # assumes that each flag is unique, and using a flag more than once
   2181  1.1  christos # causes an error to be triggered. the -flag* forms works similarly
   2182  1.1  christos # except that may appear in $argv any number of times:
   2183  1.1  christos #
   2184  1.1  christos #  - For non-arg-consuming flags, each invocation of -flag causes the
   2185  1.1  christos #    result of $script to overwrite the previous value. e.g. so
   2186  1.1  christos #    {-flag* {x} {incr foo}} has a default value of x, but passing in
   2187  1.1  christos #    -flag twice would change it to the result of incrementing foo
   2188  1.1  christos #    twice. This form can be used to implement, e.g., increasing
   2189  1.1  christos #    verbosity levels by passing -verbose multiple times.
   2190  1.1  christos #
   2191  1.1  christos #  - For arg-consuming flags, the given flag starts with value X, but
   2192  1.1  christos #    if the flag is provided in $argv, the default is cleared, then
   2193  1.1  christos #    each instance of -flag causes its value to be appended to the
   2194  1.1  christos #    result, so {-flag* => {a b c}} defaults to {a b c}, but passing
   2195  1.1  christos #    in -flag y -flag z would change it to {y z}, not {a b c y z}..
   2196  1.1  christos #
   2197  1.1  christos # By default, the args list is only inspected until the first argument
   2198  1.1  christos # which is not described by $prototype. i.e. the first "non-flag" (not
   2199  1.1  christos # counting values consumed for flags defined like -flag => default).
   2200  1.1  christos # The :all-flags pragma (see below) can modify this behavior.
   2201  1.1  christos #
   2202  1.1  christos # If a "--" flag is encountered, no more arguments are inspected as
   2203  1.1  christos # flags unless the :all-flags pragma (see below) is in effect. The
   2204  1.1  christos # first instance of "--" is removed from the target result list but
   2205  1.1  christos # all remaining instances of "--" are are passed through.
   2206  1.1  christos #
   2207  1.1  christos # Any argvName entries not described in $prototype are considered to
   2208  1.1  christos # be "non-flags" for purposes of this function, even if they
   2209  1.1  christos # ostensibly look like flags.
   2210  1.1  christos #
   2211  1.1  christos # Returns the number of flags it processed in $argvName, not counting
   2212  1.1  christos # "--".
   2213  1.1  christos #
   2214  1.1  christos # Example:
   2215  1.1  christos #
   2216  1.1  christos ## set args [list -foo -bar {blah} -z 8 9 10 -theEnd]
   2217  1.1  christos ## proj-parse-flags args flags {
   2218  1.1  christos ##   -foo    0  {expr 1}
   2219  1.1  christos ##   -bar    => 0
   2220  1.1  christos ##   -no-baz 1  {return 0}
   2221  1.1  christos ##   -z 0 2
   2222  1.1  christos ## }
   2223  1.1  christos #
   2224  1.1  christos # After that $flags would contain {-foo 1 -bar {blah} -no-baz 1 -z 2}
   2225  1.1  christos # and $args would be {8 9 10 -theEnd}.
   2226  1.1  christos #
   2227  1.1  christos # Pragmas:
   2228  1.1  christos #
   2229  1.1  christos # Passing :PRAGMAS to this function may modify how it works. The
   2230  1.1  christos # following pragmas are supported (note the leading ":"):
   2231  1.1  christos #
   2232  1.1  christos #   :all-flags indicates that the whole input list should be scanned,
   2233  1.1  christos #   not stopping at the first non-flag or "--".
   2234  1.1  christos #
   2235  1.1  christos proc proj-parse-flags {argvName tgtArrayName prototype} {
   2236  1.1  christos   upvar $argvName argv
   2237  1.1  christos   upvar $tgtArrayName outFlags
   2238  1.1  christos   array set flags {}; # staging area
   2239  1.1  christos   array set blob {}; # holds markers for various per-key state and options
   2240  1.1  christos   set incrSkip 1; # 1 if we stop at the first non-flag, else 0
   2241  1.1  christos   # Parse $prototype for flag definitions...
   2242  1.1  christos   set n [llength $prototype]
   2243  1.1  christos   set checkProtoFlag {
   2244  1.1  christos     #puts "**** checkProtoFlag #$i of $n k=$k fv=$fv"
   2245  1.1  christos     switch -exact -- $fv {
   2246  1.1  christos       -literal {
   2247  1.1  christos         proj-assert {![info exists blob(${k}.consumes)]}
   2248  1.1  christos         set blob(${k}.script) [list expr [lindex $prototype [incr i]]]
   2249  1.1  christos       }
   2250  1.1  christos       -apply {
   2251  1.1  christos         set fv [lindex $prototype [incr i]]
   2252  1.1  christos         if {2 == [llength $fv]} {
   2253  1.1  christos           # Treat this as a lambda literal
   2254  1.1  christos           set fv [list $fv]
   2255  1.1  christos         }
   2256  1.1  christos         lappend blob(${k}.call) "apply $fv"
   2257  1.1  christos       }
   2258  1.1  christos       -call {
   2259  1.1  christos         # arg is either a proc name or {apply $aLambda}
   2260  1.1  christos         set fv [lindex $prototype [incr i]]
   2261  1.1  christos         lappend blob(${k}.call) $fv
   2262  1.1  christos       }
   2263  1.1  christos       default {
   2264  1.1  christos         proj-assert {![info exists blob(${k}.consumes)]}
   2265  1.1  christos         set blob(${k}.script) $fv
   2266  1.1  christos       }
   2267  1.1  christos     }
   2268  1.1  christos     if {$i >= $n} {
   2269  1.1  christos       proj-error -up "[proj-scope]: Missing argument for $k flag"
   2270  1.1  christos     }
   2271  1.1  christos   }
   2272  1.1  christos   for {set i 0} {$i < $n} {incr i} {
   2273  1.1  christos     set k [lindex $prototype $i]
   2274  1.1  christos     #puts "**** #$i of $n k=$k"
   2275  1.1  christos 
   2276  1.1  christos     # Check for :PRAGMA...
   2277  1.1  christos     switch -exact -- $k {
   2278  1.1  christos       :all-flags {
   2279  1.1  christos         set incrSkip 0
   2280  1.1  christos         continue
   2281  1.1  christos       }
   2282  1.1  christos     }
   2283  1.1  christos 
   2284  1.1  christos     proj-assert {[string match -* $k]} \
   2285  1.1  christos       "Invalid argument: $k"
   2286  1.1  christos 
   2287  1.1  christos     if {[string match {*\*} $k]} {
   2288  1.1  christos       # Re-map -foo* to -foo and flag -foo as a repeatable flag
   2289  1.1  christos       set k [string map {* ""} $k]
   2290  1.1  christos       incr blob(${k}.multi)
   2291  1.1  christos     }
   2292  1.1  christos 
   2293  1.1  christos     if {[info exists flags($k)]} {
   2294  1.1  christos       proj-error -up "[proj-scope]: Duplicated prototype for flag $k"
   2295  1.1  christos     }
   2296  1.1  christos 
   2297  1.1  christos     switch -exact -- [lindex $prototype [expr {$i + 1}]] {
   2298  1.1  christos       => {
   2299  1.1  christos         # -flag => DFLT ?-subflag arg?
   2300  1.1  christos         incr i 2
   2301  1.1  christos         if {$i >= $n} {
   2302  1.1  christos           proj-error -up "[proj-scope]: Missing argument for $k => flag"
   2303  1.1  christos         }
   2304  1.1  christos         incr blob(${k}.consumes)
   2305  1.1  christos         set vi [lindex $prototype $i]
   2306  1.1  christos         if {$vi in {-apply -call}} {
   2307  1.1  christos           proj-error -up "[proj-scope]: Missing default value for $k flag"
   2308  1.1  christos         } else {
   2309  1.1  christos           set fv [lindex $prototype [expr {$i + 1}]]
   2310  1.1  christos           if {$fv in {-apply -call}} {
   2311  1.1  christos             incr i
   2312  1.1  christos             eval $checkProtoFlag
   2313  1.1  christos           }
   2314  1.1  christos         }
   2315  1.1  christos       }
   2316  1.1  christos       default {
   2317  1.1  christos         # -flag VALUE ?flag? SCRIPT
   2318  1.1  christos         set vi [lindex $prototype [incr i]]
   2319  1.1  christos         set fv [lindex $prototype [incr i]]
   2320  1.1  christos         eval $checkProtoFlag
   2321  1.1  christos       }
   2322  1.1  christos     }
   2323  1.1  christos     #puts "**** #$i of $n k=$k vi=$vi"
   2324  1.1  christos     set flags($k) $vi
   2325  1.1  christos   }
   2326  1.1  christos   #puts "-- flags"; parray flags
   2327  1.1  christos   #puts "-- blob"; parray blob
   2328  1.1  christos   set rc 0
   2329  1.1  christos   set rv {}; # staging area for the target argv value
   2330  1.1  christos   set skipMode 0
   2331  1.1  christos   set n [llength $argv]
   2332  1.1  christos   # Now look for those flags in $argv...
   2333  1.1  christos   for {set i 0} {$i < $n} {incr i} {
   2334  1.1  christos     set arg [lindex $argv $i]
   2335  1.1  christos     #puts "-- [proj-scope] arg=$arg"
   2336  1.1  christos     if {$skipMode} {
   2337  1.1  christos       lappend rv $arg
   2338  1.1  christos     } elseif {"--" eq $arg} {
   2339  1.1  christos       # "--" is the conventional way to end processing of args
   2340  1.1  christos       if {[incr blob(--)] > 1} {
   2341  1.1  christos         # Elide only the first one
   2342  1.1  christos         lappend rv $arg
   2343  1.1  christos       }
   2344  1.1  christos       incr skipMode $incrSkip
   2345  1.1  christos     } elseif {[info exists flags($arg)]} {
   2346  1.1  christos       # A known flag...
   2347  1.1  christos       set isMulti [info exists blob(${arg}.multi)]
   2348  1.1  christos       incr blob(${arg}.seen)
   2349  1.1  christos       if {1 < $blob(${arg}.seen) && !$isMulti} {
   2350  1.1  christos         proj-error -up [proj-scope] "$arg flag was used multiple times"
   2351  1.1  christos       }
   2352  1.1  christos       set vMode 0; # 0=as-is, 1=eval, 2=call
   2353  1.1  christos       set isConsuming [info exists blob(${arg}.consumes)]
   2354  1.1  christos       if {$isConsuming} {
   2355  1.1  christos         incr i
   2356  1.1  christos         if {$i >= $n} {
   2357  1.1  christos           proj-error -up [proj-scope] "is missing argument for $arg flag"
   2358  1.1  christos         }
   2359  1.1  christos         set vv [lindex $argv $i]
   2360  1.1  christos       } elseif {[info exists blob(${arg}.script)]} {
   2361  1.1  christos         set vMode 1
   2362  1.1  christos         set vv $blob(${arg}.script)
   2363  1.1  christos       } else {
   2364  1.1  christos         set vv $flags($arg)
   2365  1.1  christos       }
   2366  1.1  christos 
   2367  1.1  christos       if {[info exists blob(${arg}.call)]} {
   2368  1.1  christos         set vMode 2
   2369  1.1  christos         set vv [concat {*}$blob(${arg}.call) $arg $vv]
   2370  1.1  christos       } elseif {$isConsuming} {
   2371  1.1  christos         proj-assert {!$vMode}
   2372  1.1  christos         # fall through
   2373  1.1  christos       } elseif {"" eq $vv || [string is double -strict $vv]} {
   2374  1.1  christos         set vMode 0
   2375  1.1  christos       } elseif {$vv in {incr}} {
   2376  1.1  christos         set vMode 0
   2377  1.1  christos         switch -exact $vv {
   2378  1.1  christos           incr {
   2379  1.1  christos             set xx $flags($k); incr xx; set vv $xx; unset xx
   2380  1.1  christos           }
   2381  1.1  christos           default {
   2382  1.1  christos             proj-error "Unhandled \$vv value $vv"
   2383  1.1  christos           }
   2384  1.1  christos         }
   2385  1.1  christos       } else {
   2386  1.1  christos         set vv [list eval $vv]
   2387  1.1  christos         set vMode 1
   2388  1.1  christos       }
   2389  1.1  christos       if {$vMode} {
   2390  1.1  christos         set code [catch [list uplevel 1 $vv] vv xopt]
   2391  1.1  christos         if {$code ni {0 2}} {
   2392  1.1  christos           return {*}$xopt $vv
   2393  1.1  christos         }
   2394  1.1  christos       }
   2395  1.1  christos       if {$isConsuming && $isMulti} {
   2396  1.1  christos         if {1 == $blob(${arg}.seen)} {
   2397  1.1  christos           # On the first hit, overwrite the default with a new list.
   2398  1.1  christos           set flags($arg) [list $vv]
   2399  1.1  christos         } else {
   2400  1.1  christos           # On subsequent hits, append to the list.
   2401  1.1  christos           lappend flags($arg) $vv
   2402  1.1  christos         }
   2403  1.1  christos       } else {
   2404  1.1  christos         set flags($arg) $vv
   2405  1.1  christos       }
   2406  1.1  christos       incr rc
   2407  1.1  christos     } else {
   2408  1.1  christos       # Non-flag
   2409  1.1  christos       incr skipMode $incrSkip
   2410  1.1  christos       lappend rv $arg
   2411  1.1  christos     }
   2412  1.1  christos   }
   2413  1.1  christos   set argv $rv
   2414  1.1  christos   array set outFlags [array get flags]
   2415  1.1  christos   #puts "-- rv=$rv argv=$argv flags="; parray flags
   2416  1.1  christos   return $rc
   2417  1.1  christos }; # proj-parse-flags
   2418  1.1  christos 
   2419  1.1  christos #
   2420  1.1  christos # Older (deprecated) name of proj-parse-flags.
   2421  1.1  christos #
   2422  1.1  christos proc proj-parse-simple-flags {args} {
   2423  1.1  christos   tailcall proj-parse-flags {*}$args
   2424  1.1  christos }
   2425  1.1  christos 
   2426  1.1  christos if {$::proj__Config(self-tests)} {
   2427  1.1  christos   set __ova $::proj__Config(verbose-assert);
   2428  1.1  christos   set ::proj__Config(verbose-assert) 1
   2429  1.1  christos   puts "Running [info script] self-tests..."
   2430  1.1  christos   # proj-cache...
   2431  1.1  christos   apply {{} {
   2432  1.1  christos     #proj-warn "Test code for proj-cache"
   2433  1.1  christos     proj-assert {![proj-cache-check -key here check]}
   2434  1.1  christos     proj-assert {"here" eq [proj-cache-key here]}
   2435  1.1  christos     proj-assert {"" eq $check}
   2436  1.1  christos     proj-cache-set -key here thevalue
   2437  1.1  christos     proj-assert {[proj-cache-check -key here check]}
   2438  1.1  christos     proj-assert {"thevalue" eq $check}
   2439  1.1  christos 
   2440  1.1  christos     proj-assert {![proj-cache-check check]}
   2441  1.1  christos     #puts "*** key = ([proj-cache-key 0])"
   2442  1.1  christos     proj-assert {"" eq $check}
   2443  1.1  christos     proj-cache-set abc
   2444  1.1  christos     proj-assert {[proj-cache-check check]}
   2445  1.1  christos     proj-assert {"abc" eq $check}
   2446  1.1  christos 
   2447  1.1  christos     #parray ::proj__Cache;
   2448  1.1  christos     proj-assert {"" ne [proj-cache-remove]}
   2449  1.1  christos     proj-assert {![proj-cache-check check]}
   2450  1.1  christos     proj-assert {"" eq [proj-cache-remove]}
   2451  1.1  christos     proj-assert {"" eq $check}
   2452  1.1  christos   }}
   2453  1.1  christos 
   2454  1.1  christos   # proj-parse-flags ...
   2455  1.1  christos   apply {{} {
   2456  1.1  christos     set foo 3
   2457  1.1  christos     set argv {-a "hi - world" -b -b -b -- -a {bye bye} -- -d -D c -a "" --}
   2458  1.1  christos     proj-parse-flags argv flags {
   2459  1.1  christos       :all-flags
   2460  1.1  christos       -a* => "gets overwritten"
   2461  1.1  christos       -b* 7 {incr foo}
   2462  1.1  christos       -d 1 0
   2463  1.1  christos       -D 0 1
   2464  1.1  christos     }
   2465  1.1  christos 
   2466  1.1  christos     #puts "-- argv = $argv"; parray flags;
   2467  1.1  christos     proj-assert {"-- c --" eq $argv}
   2468  1.1  christos     proj-assert {$flags(-a) eq "{hi - world} {bye bye} {}"}
   2469  1.1  christos     proj-assert {$foo == 6}
   2470  1.1  christos     proj-assert {$flags(-b) eq $foo}
   2471  1.1  christos     proj-assert {$flags(-d) == 0}
   2472  1.1  christos     proj-assert {$flags(-D) == 1}
   2473  1.1  christos     set foo 0
   2474  1.1  christos     foreach x $flags(-a) {
   2475  1.1  christos       proj-assert {$x in {{hi - world} {bye bye} {}}}
   2476  1.1  christos       incr foo
   2477  1.1  christos     }
   2478  1.1  christos     proj-assert {3 == $foo}
   2479  1.1  christos 
   2480  1.1  christos     set argv {-a {hi world} -b -maybe -- -a {bye bye} -- -b c --}
   2481  1.1  christos     set foo 0
   2482  1.1  christos     proj-parse-flags argv flags {
   2483  1.1  christos       -a => "aaa"
   2484  1.1  christos       -b 0 {incr foo}
   2485  1.1  christos       -maybe no -literal yes
   2486  1.1  christos     }
   2487  1.1  christos     #parray flags; puts "--- argv = $argv"
   2488  1.1  christos     proj-assert {"-a {bye bye} -- -b c --" eq $argv}
   2489  1.1  christos     proj-assert {$flags(-a) eq "hi world"}
   2490  1.1  christos     proj-assert {1 == $flags(-b)}
   2491  1.1  christos     proj-assert {"yes" eq $flags(-maybe)}
   2492  1.1  christos 
   2493  1.1  christos     set argv {-f -g -a aaa -M -M -M -L -H -A AAA a b c}
   2494  1.1  christos     set foo 0
   2495  1.1  christos     set myLambda {{flag val} {
   2496  1.1  christos       proj-assert {$flag in {-f -g -M}}
   2497  1.1  christos       #puts "myLambda flag=$flag val=$val"
   2498  1.1  christos       incr val
   2499  1.1  christos     }}
   2500  1.1  christos     proc myNonLambda {flag val} {
   2501  1.1  christos       proj-assert {$flag in {-A -a}}
   2502  1.1  christos       #puts "myNonLambda flag=$flag val=$val"
   2503  1.1  christos       concat $val $val
   2504  1.1  christos     }
   2505  1.1  christos     proj-parse-flags argv flags {
   2506  1.1  christos       -f 0 -call {apply $myLambda}
   2507  1.1  christos       -g 2 -apply $myLambda
   2508  1.1  christos       -h 3 -apply $myLambda
   2509  1.1  christos       -H 30 33
   2510  1.1  christos       -a => aAAAa -apply {{f v} {
   2511  1.1  christos         set v
   2512  1.1  christos       }}
   2513  1.1  christos       -A => AaaaA -call myNonLambda
   2514  1.1  christos       -B => 17 -call myNonLambda
   2515  1.1  christos       -M* 0 -apply $myLambda
   2516  1.1  christos       -L "" -literal $myLambda
   2517  1.1  christos     }
   2518  1.1  christos     rename myNonLambda ""
   2519  1.1  christos     #puts "--- argv = $argv"; parray flags
   2520  1.1  christos     proj-assert {$flags(-f) == 1}
   2521  1.1  christos     proj-assert {$flags(-g) == 3}
   2522  1.1  christos     proj-assert {$flags(-h) == 3}
   2523  1.1  christos     proj-assert {$flags(-H) == 33}
   2524  1.1  christos     proj-assert {$flags(-a) == {aaa}}
   2525  1.1  christos     proj-assert {$flags(-A) eq "AAA AAA"}
   2526  1.1  christos     proj-assert {$flags(-B) == 17}
   2527  1.1  christos     proj-assert {$flags(-M) == 3}
   2528  1.1  christos     proj-assert {$flags(-L) eq $myLambda}
   2529  1.1  christos 
   2530  1.1  christos     set argv {-touch -validate}
   2531  1.1  christos     proj-parse-flags argv flags {
   2532  1.1  christos       -touch "" {return "-touch"}
   2533  1.1  christos       -validate 0 1
   2534  1.1  christos     }
   2535  1.1  christos     #puts "----- argv = $argv"; parray flags
   2536  1.1  christos     proj-assert {$flags(-touch) eq "-touch"}
   2537  1.1  christos     proj-assert {$flags(-validate) == 1}
   2538  1.1  christos     proj-assert {$argv eq {}}
   2539  1.1  christos 
   2540  1.1  christos     set argv {-i -i -i}
   2541  1.1  christos     proj-parse-flags argv flags {
   2542  1.1  christos       -i* 0 incr
   2543  1.1  christos     }
   2544  1.1  christos     proj-assert {3 == $flags(-i)}
   2545  1.1  christos   }}
   2546  1.1  christos   set ::proj__Config(verbose-assert) $__ova
   2547  1.1  christos   unset __ova
   2548  1.1  christos   puts "Done running [info script] self-tests."
   2549  1.1  christos }; # proj- API self-tests
   2550