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