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