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