Overview
| Comment: | wip |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.6584-ck5 |
| Files: | files | file ages | folders |
| SHA1: |
a8d4af197f35baa2b255507ad1be0f03 |
| User & Date: | matt on 2021-04-18 20:58:19 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-04-18
| ||
| 21:07 | wiphtop check-in: cecf838aa0 user: matt tags: v1.6584-ck5 | |
| 20:58 | wip check-in: a8d4af197f user: matt tags: v1.6584-ck5 | |
| 16:48 | wip - renamed read-config to configf:read-config check-in: b252166d42 user: matt tags: v1.6584-ck5 | |
Changes
Modified bigmod.scm from [3ff83f9c3d] to [9d3b4cd8d6].
| ︙ | ︙ | |||
17 18 19 20 21 22 23 24 25 | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit bigmod)) (declare (uses debugprint)) (declare (uses commonmod)) (declare (uses configfmod)) | > | | > | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | > > | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit bigmod)) (declare (uses debugprint)) (declare (uses mtargs)) (declare (uses commonmod)) (declare (uses configfmod)) (declare (uses dbmod)) (declare (uses rmtmod)) (module bigmod () (import scheme chicken.base chicken.condition chicken.file chicken.io chicken.pathname chicken.port chicken.pretty-print chicken.process chicken.process-context chicken.sort chicken.string chicken.time chicken.module debugprint (prefix mtargs args:) commonmod configfmod ;; dbmod ;; rmtmod (prefix base64 base64:) ;; (prefix dbi dbi:) (prefix sqlite3 sqlite3:) (srfi 18) directory-utils format matchable md5 message-digest regex regex-case sparse-vectors srfi-1 srfi-13 srfi-69 stack typed-records z3 ) (reexport scheme chicken.base chicken.condition chicken.file chicken.io chicken.pathname chicken.port chicken.pretty-print chicken.process chicken.process-context chicken.sort chicken.string chicken.time chicken.module (prefix base64 base64:) ;; (prefix dbi dbi:) (prefix sqlite3 sqlite3:) (srfi 18) directory-utils format matchable md5 message-digest regex regex-case sparse-vectors srfi-1 srfi-13 srfi-69 stack typed-records z3 commonmod configfmod ;; dbmod debugprint ;; rmtmod ) ) |
Modified commonmod.scm from [4cf1c3bb0a] to [0b83b5ae2b].
| ︙ | ︙ | |||
1115 1116 1117 1118 1119 1120 1121 |
(set! res #t))))
(string-split patts ","))
res)
#t))
;;======================================================================
;; '(print (string-intersperse (map cadr (hash-table-ref/default (configf:read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
| | | | 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 |
(set! res #t))))
(string-split patts ","))
res)
#t))
;;======================================================================
;; '(print (string-intersperse (map cadr (hash-table-ref/default (configf:read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
(define (common:get-disks configf)
(hash-table-ref/default
configf ;; (or configf (configf:read-config "megatest.config" #f #t))
"disks" '("none" "")))
;;======================================================================
;; return first command that exists, else #f
;;
(define (common:which cmds)
(if (null? cmds)
|
| ︙ | ︙ | |||
1225 1226 1227 1228 1229 1230 1231 | ;; T A R G E T S , S T A T E , S T A T U S , ;; R U N N A M E A N D T E S T P A T T ;;====================================================================== ;;====================================================================== ;; (map print (map car (hash-table->alist (configf:read-config "runconfigs.config" #f #t)))) ;; | | | | | > | 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 |
;; T A R G E T S , S T A T E , S T A T U S ,
;; R U N N A M E A N D T E S T P A T T
;;======================================================================
;;======================================================================
;; (map print (map car (hash-table->alist (configf:read-config "runconfigs.config" #f #t))))
;;
(define (common:get-runconfig-targets configf) ;; #!key (configf #f))
(let ((targs (sort (map car (hash-table->alist configf
#;(or configf ;; NOTE: There is no value in using runconfig:read here.
(configf:read-config (conc *toppath* "/runconfigs.config")
#f #t)
(make-hash-table))
))
string<?))
(target-patt (args:get-arg "-target")))
(if target-patt
(filter (lambda (x)
(patt-list-match x target-patt))
targs)
targs)))
|
| ︙ | ︙ | |||
3155 3156 3157 3158 3159 3160 3161 |
;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
(define (common:load-views-config)
(let* ((view-cfgdat (make-hash-table))
(home-cfgfile (conc (get-environment-variable "HOME") "/.mtviews.config"))
(mthome-cfgfile (conc *toppath* "/.mtviews.config")))
(if (common:file-exists? mthome-cfgfile)
| | | 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 |
;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
(define (common:load-views-config)
(let* ((view-cfgdat (make-hash-table))
(home-cfgfile (conc (get-environment-variable "HOME") "/.mtviews.config"))
(mthome-cfgfile (conc *toppath* "/.mtviews.config")))
(if (common:file-exists? mthome-cfgfile)
(configf:read-config mthome-cfgfile view-cfgdat))
;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas
(if (common:file-exists? home-cfgfile)
(configf:read-config home-cfgfile view-cfgdat #t))
view-cfgdat))
;;======================================================================
;; H I E R A R C H I C A L H A S H T A B L E S
|
| ︙ | ︙ |
Modified configfmod.scm from [f126e8c24b] to [6693a9270b].
| ︙ | ︙ | |||
399 400 401 402 403 404 405 | (debug:print 2 *default-log-port* " " full-conf)) (for-each (lambda (fpath) ;; (push-directory conf-dir) (debug:print 9 *default-log-port* "Including: " full-conf) (configf:read-config fpath res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings | | | | 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 |
(debug:print 2 *default-log-port* " " full-conf))
(for-each
(lambda (fpath)
;; (push-directory conf-dir)
(debug:print 9 *default-log-port* "Including: " full-conf)
(configf:read-config fpath res allow-system environ-patt: environ-patt
curr-section: curr-section-name sections: sections settings: settings
keep-filenames: keep-filenames env-to-use: env-to-use))
all-matches))
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings env-to-use)
curr-section-name #f #f))))
(configf:script-rx ( x include-script params);; handle-exceptions
;; exn
;; (begin
;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.")
;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(if (and (file-exists? include-script)(file-executable? include-script))
(let* ((local-allow-system (calc-allow-system allow-system curr-section-name sections))
(env-delta (configf:cfgdat->env-alist curr-section-name res local-allow-system))
(new-inp-port
(common:with-env-vars
env-delta
(lambda ()
(open-input-pipe (conc include-script " " params))))))
(debug:print '(2 9) *default-log-port* "Including from script output: " include-script)
;; (print "We got here, calling configf:read-config next. Port is: " new-inp-port)
(configf:read-config new-inp-port res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames env-to-use: env-to-use)
(close-input-port new-inp-port)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings env-to-use) curr-section-name #f #f))
(begin
(debug:print 0 *default-log-port* "Script not found or not exectutable: " include-script)
(loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings env-to-use) curr-section-name #f #f)))
) ;; )
(configf:section-rx ( x section-name )
|
| ︙ | ︙ | |||
608 609 610 611 612 613 614 | ;; ;; (list var val)))) ;; ;;====================================================================== ;; setup ;;====================================================================== ;;====================================================================== | > | | 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 |
;; ;; (list var val))))
;;
;;======================================================================
;; setup
;;======================================================================
;;======================================================================
;; This should not be here.
#;(define (setup)
(let* ((configf (find-config "megatest.config"))
(config (if configf (configf:read-config configf #f #t) #f)))
(if config
(setenv "RUN_AREA_HOME" (pathname-directory configf)))
config))
(define (safe-setenv key val)
|
| ︙ | ︙ | |||
950 951 952 953 954 955 956 |
(configf:read-config fname ht #t environ-patt: environ-patt sections: (if target (list "default" target) #f))))
;;======================================================================
;; Config file handling
;;======================================================================
;; convert to param?
| | | 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 |
(configf:read-config fname ht #t environ-patt: environ-patt sections: (if target (list "default" target) #f))))
;;======================================================================
;; Config file handling
;;======================================================================
;; convert to param?
(define configf:std-imports "") ;;(import configfmod commonmod)")
(define (configf:process-line l ht allow-system env-to-use #!key (linenum #f))
(let loop ((res l))
(if (string? res)
(let ((matchdat (string-search configf:var-expand-regex res)))
(if matchdat
(let* ((prestr (list-ref matchdat 1))
|
| ︙ | ︙ | |||
986 987 988 989 990 991 992 |
((sect var)(conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))"))
(else
(debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.")
"(lambda (ht) #f)")))
((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
(else "(lambda (ht)(print \"ERROR\") \"ERROR\")")))))
| | | 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 |
((sect var)(conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))"))
(else
(debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.")
"(lambda (ht) #f)")))
((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
(else "(lambda (ht)(print \"ERROR\") \"ERROR\")")))))
;; (print "fullcmd=" fullcmd)
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\", exn=" exn)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
;; (print "exn=" (condition->list exn))
(set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd)))
|
| ︙ | ︙ | |||
1015 1016 1017 1018 1019 1020 1021 | (debug:print-info 9 *default-log-port* "for line \"" l "\"\n command: " cmd " took " delta " seconds to run with output:\n " result))))) (loop (conc prestr result poststr))) res)) res))) ;; pathenvvar will set the named var to the path of the config | | | | 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 |
(debug:print-info 9 *default-log-port* "for line \"" l "\"\n command: " cmd " took " delta " seconds to run with output:\n " result)))))
(loop (conc prestr result poststr)))
res))
res)))
;; pathenvvar will set the named var to the path of the config
(define (configf:find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f)(env-to-use #f))
(let* ((curr-dir (current-directory))
(configinfo (find-config fname toppath: given-toppath))
(toppath (car configinfo))
(configfile (cadr configinfo))
(set-fields (lambda (curr-section next-section ht path)
(let ((field-names (if ht (common:get-fields ht) '()))
(target (or (getenv "MT_TARGET")(args:get-arg "-reqtarg")(args:get-arg "-target"))))
(debug:print-info 9 *default-log-port* "set-fields with field-names=" field-names " target=" target " curr-section=" curr-section " next-section=" next-section " path=" path " ht=" ht)
(if (not (null? field-names))(keys:target-set-args field-names target #f))))))
(if toppath (change-directory toppath))
(if (and toppath pathenvvar)(setenv pathenvvar toppath))
(let ((configdat (if configfile
(configf:read-config configfile #f #t environ-patt: environ-patt post-section-procs: (list (cons "^fields$" set-fields)) #f env-to-use: env-to-use))))
(if toppath (change-directory curr-dir))
(list configdat toppath configfile fname))))
;;======================================================================
;; Non destructive writing of config file
;;======================================================================
|
| ︙ | ︙ |
Modified dbmod.scm from [7b37a0ea03] to [6d0e6f1813].
| ︙ | ︙ | |||
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | (module dbmod * (import scheme (prefix sqlite3 sqlite3:) chicken.base chicken.condition chicken.file chicken.file.posix chicken.format chicken.io chicken.pathname chicken.port chicken.pretty-print chicken.process chicken.process-context chicken.process-context.posix chicken.sort chicken.string chicken.time chicken.time.posix | > | | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | (module dbmod * (import scheme (prefix sqlite3 sqlite3:) chicken.base chicken.condition chicken.eval chicken.file chicken.file.posix chicken.format chicken.io chicken.pathname chicken.port chicken.pretty-print chicken.process chicken.process-context chicken.process-context.posix chicken.sort chicken.string chicken.time chicken.time.posix (prefix base64 base64:) csv-xml directory-utils matchable regex s11n srfi-1 |
| ︙ | ︙ | |||
5381 5382 5383 5384 5385 5386 5387 | (let loop ((hed (car test-dirs)) (tal (cdr test-dirs))) ;; Setting MT_LINKTREE here is almost certainly unnecessary. (let ((tconfig-file (conc hed "/" test-name "/testconfig"))) (if (and (common:file-exists? tconfig-file) (file-readable? tconfig-file)) (let ((link-tree-path (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")) | | > | | 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 | (let loop ((hed (car test-dirs)) (tal (cdr test-dirs))) ;; Setting MT_LINKTREE here is almost certainly unnecessary. (let ((tconfig-file (conc hed "/" test-name "/testconfig"))) (if (and (common:file-exists? tconfig-file) (file-readable? tconfig-file)) (let ((link-tree-path (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")) (old-link-tree (get-environment-variable "MT_LINKTREE")) (bigmodenv (module-environment 'bigmod))) (if link-tree-path (setenv "MT_LINKTREE" link-tree-path)) (let ((newtcfg (configf:read-config tconfig-file #f #f env-to-use: bigmodenv))) ;; NOTE: Does NOT run [system ...] (hash-table-set! *testconfigs* test-name newtcfg) (if old-link-tree (setenv "MT_LINKTREE" old-link-tree) (unsetenv "MT_LINKTREE")) newtcfg)) (if (null? tal) (begin |
| ︙ | ︙ |
Modified ezstepsmod.scm from [0ccdb56647] to [857570fa0d].
| ︙ | ︙ | |||
35 36 37 38 39 40 41 42 43 44 45 46 47 48 | (module ezstepsmod * (import scheme (prefix sqlite3 sqlite3:) chicken.base chicken.condition chicken.file chicken.file.posix chicken.format chicken.io chicken.pathname chicken.port chicken.pretty-print | > | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | (module ezstepsmod * (import scheme (prefix sqlite3 sqlite3:) chicken.base chicken.condition chicken.eval chicken.file chicken.file.posix chicken.format chicken.io chicken.pathname chicken.port chicken.pretty-print |
| ︙ | ︙ | |||
298 299 300 301 302 303 304 |
logpro-used))
(define (ezsteps:run-from testdat start-step-name run-one)
;;# TODO - recapture item variables, debug repeated step eval; regen logpro from test
(let* ((do-update-test-state-status #f)
(test-run-dir ;; (filedb:get-path *fdb*
(db:test-get-rundir testdat)) ;; )
| > | | 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 |
logpro-used))
(define (ezsteps:run-from testdat start-step-name run-one)
;;# TODO - recapture item variables, debug repeated step eval; regen logpro from test
(let* ((do-update-test-state-status #f)
(test-run-dir ;; (filedb:get-path *fdb*
(db:test-get-rundir testdat)) ;; )
(bigmodenv (module-environment 'bigmod))
(testconfig (configf:read-config (conc test-run-dir "/testconfig") #f #t environ-patt: "pre-launch-env-vars" env-to-use: bigmodenv))
(ezstepslst (hash-table-ref/default testconfig "ezsteps" '()))
(run-mutex (make-mutex))
(rollup-status 0)
(rollup-status-string #f)
(rollup-status-sym #f)
(exit-info (vector #t #t #t))
(test-id (db:test-get-id testdat))
|
| ︙ | ︙ |
Modified launchmod.scm from [26d0caba3d] to [f226b54f79].
| ︙ | ︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | (declare (uses mtmod)) (declare (uses mtver)) (declare (uses processmod)) (declare (uses rmtmod)) (declare (uses servermod)) (declare (uses subrunmod)) (declare (uses testsmod)) (module launchmod * (import scheme (prefix sqlite3 sqlite3:) chicken.base chicken.condition chicken.file chicken.file.posix chicken.format chicken.io chicken.pathname chicken.port chicken.pretty-print | > > | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | (declare (uses mtmod)) (declare (uses mtver)) (declare (uses processmod)) (declare (uses rmtmod)) (declare (uses servermod)) (declare (uses subrunmod)) (declare (uses testsmod)) (declare (uses bigmod)) (module launchmod * (import scheme (prefix sqlite3 sqlite3:) chicken.base chicken.condition chicken.eval chicken.file chicken.file.posix chicken.format chicken.io chicken.pathname chicken.port chicken.pretty-print |
| ︙ | ︙ | |||
77 78 79 80 81 82 83 84 85 86 87 88 89 90 | z3 sxml-serializer sxml-modifications (prefix sxml-modifications sxml-) sxml-transforms (prefix mtargs args:) commonmod configfmod dbmod debugprint ezstepsmod keysmod mtmod | > | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | z3 sxml-serializer sxml-modifications (prefix sxml-modifications sxml-) sxml-transforms (prefix mtargs args:) bigmod commonmod configfmod dbmod debugprint ezstepsmod keysmod mtmod |
| ︙ | ︙ | |||
885 886 887 888 889 890 891 |
*toppath*)
;; there are no existing cached configs, do full reads of the configs and cache them
;; we have all the info needed to fully process runconfigs and megatest.config
((and ;; (not force-reread) ;; force-reread is irrelevant in the AND, could however OR it?
mtcachef
rccachef) ;; BB- why are we doing this without asking if caching is desired?
;;(BB> "launch:setup-body -- cond branch 2")
| > | | > | > | 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 |
*toppath*)
;; there are no existing cached configs, do full reads of the configs and cache them
;; we have all the info needed to fully process runconfigs and megatest.config
((and ;; (not force-reread) ;; force-reread is irrelevant in the AND, could however OR it?
mtcachef
rccachef) ;; BB- why are we doing this without asking if caching is desired?
;;(BB> "launch:setup-body -- cond branch 2")
(let* ((bigmodenv (module-environment 'bigmod))
(first-pass (configf:find-and-read-config ;; NB// sets MT_RUN_AREA_HOME as side effect
mtconfig
environ-patt: "env-override"
given-toppath: toppath
pathenvvar: "MT_RUN_AREA_HOME"
env-to-use: bigmodenv))
(first-rundat (let ((toppath (if toppath
toppath
(car first-pass))))
(configf:read-config ;; (conc toppath "/runconfigs.config") ;; this should be converted to runconfig:read but it is non-trivial, leaving it for now.
(conc (if (string? toppath)
toppath
(get-environment-variable "MT_RUN_AREA_HOME"))
"/runconfigs.config")
*runconfigdat* #t
sections: sections
env-to-use: bigmodenv))))
(set! *runconfigdat* first-rundat)
(if first-pass ;;
(begin
;;(BB> "launch:setup-body -- \"first-pass\"=first-pass")
(set! *configdat* (car first-pass))
;;(BB> "launch:setup-body -- 2 set! *configdat*="*configdat*)
(set! *configinfo* first-pass)
|
| ︙ | ︙ | |||
922 923 924 925 926 927 928 | (let* ((keys (common:list-or-null (rmt:get-keys) message: "Failed to retrieve keys in launch.scm. Please report this to the developers.")) (key-vals (keys:target->keyval keys target)) (linktree (common:get-linktree)) ;; (or (getenv "MT_LINKTREE")(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))) ; (if *configdat* ; (configf:lookup *configdat* "setup" "linktree") ; (conc *toppath* "/lt")))) | | | > | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 |
(let* ((keys (common:list-or-null (rmt:get-keys)
message: "Failed to retrieve keys in launch.scm. Please report this to the developers."))
(key-vals (keys:target->keyval keys target))
(linktree (common:get-linktree)) ;; (or (getenv "MT_LINKTREE")(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))
; (if *configdat*
; (configf:lookup *configdat* "setup" "linktree")
; (conc *toppath* "/lt"))))
(second-pass (configf:find-and-read-config
mtconfig
environ-patt: "env-override"
given-toppath: toppath
pathenvvar: "MT_RUN_AREA_HOME"
env-to-use: (module-environment 'bigmod)))
(runconfigdat (begin ;; this read of the runconfigs will see any adjustments made by re-reading megatest.config
(for-each (lambda (kt)
(setenv (car kt) (cadr kt)))
key-vals)
(configf:read-config (conc toppath "/runconfigs.config") *runconfigdat* #t ;; consider using runconfig:read some day ...
sections: sections)))
(cachefiles (launch:get-cache-file-paths areapath toppath target mtconfig))
|
| ︙ | ︙ | |||
960 961 962 963 964 965 966 |
(set! *configdat* (make-hash-table))
)))
;; else read what you can and set the flag accordingly
;; here we don't have either mtconfig or rccachef
(else
;;(BB> "launch:setup-body -- cond branch 3 - else")
| | | > | 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 |
(set! *configdat* (make-hash-table))
)))
;; else read what you can and set the flag accordingly
;; here we don't have either mtconfig or rccachef
(else
;;(BB> "launch:setup-body -- cond branch 3 - else")
(let* ((cfgdat (configf:find-and-read-config
(or (args:get-arg "-config") "megatest.config")
environ-patt: "env-override"
given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
pathenvvar: "MT_RUN_AREA_HOME"
env-to-read: (module-environment 'bigmod))))
(if (and cfgdat (list? cfgdat) (> (length cfgdat) 0) (hash-table? (car cfgdat)))
(let* ((toppath (or (get-environment-variable "MT_RUN_AREA_HOME")(cadr cfgdat)))
(rdat (configf:read-config (conc toppath ;; convert this to use runconfig:read!
"/runconfigs.config") *runconfigdat* #t sections: sections)))
(set! *configinfo* cfgdat)
(set! *configdat* (car cfgdat))
|
| ︙ | ︙ | |||
2243 2244 2245 2246 2247 2248 2249 |
#f))
(cfgf (if rundir (conc rundir "/.runconfig." megatest-version "-" megatest-fossil-hash) #f)))
(if (and cfgf
(common:file-exists? cfgf)
(file-writable? cfgf)
(common:use-cache?))
(configf:read-alist cfgf)
| > | | 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 |
#f))
(cfgf (if rundir (conc rundir "/.runconfig." megatest-version "-" megatest-fossil-hash) #f)))
(if (and cfgf
(common:file-exists? cfgf)
(file-writable? cfgf)
(common:use-cache?))
(configf:read-alist cfgf)
(let* ((gotit (if cfgf #t (launch:setup))) ;; whatever
(keys (common:get-fields cfgf)) ;; (rmt:get-keys))
(target (common:args-get-target))
(key-vals (if target (keys:target->keyval keys target) #f))
(sections (if target (list "default" target) #f))
(data (begin
(setenv "MT_RUN_AREA_HOME" *toppath*)
(if key-vals
(for-each (lambda (kt)
|
| ︙ | ︙ |
Modified megatest.scm from [aec1731c6e] to [f5acd0dd12].
| ︙ | ︙ | |||
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | (declare (uses csv-xml)) (declare (uses hostinfo)) (declare (uses adjutant)) (declare (uses archivemod)) (declare (uses apimod)) (declare (uses autoload)) (declare (uses commonmod)) (declare (uses configfmod)) (declare (uses dbmod)) (declare (uses dbi)) (declare (uses ducttape-lib)) (declare (uses ezstepsmod)) (declare (uses http-transportmod)) (declare (uses launchmod)) (declare (uses mtargs)) (declare (uses mtver)) (declare (uses mutils)) (declare (uses processmod)) (declare (uses rmtmod)) (declare (uses runsmod)) (declare (uses servermod)) (declare (uses testsmod)) ;; (include "call-with-environment-variables/call-with-environment-variables.scm") (module megatest-main * (import scheme chicken.base chicken.bitwise chicken.condition chicken.file chicken.file.posix chicken.format chicken.io chicken.irregex chicken.pathname chicken.port chicken.pretty-print chicken.process chicken.process-context chicken.process-context.posix chicken.process.signal chicken.random chicken.repl chicken.sort chicken.string chicken.tcp chicken.time chicken.time.posix (prefix sqlite3 sqlite3:) | > > > > > > > > > > > > > > | > > > < < < > > > | > | < | < < < < < > | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | (declare (uses csv-xml)) (declare (uses hostinfo)) (declare (uses adjutant)) (declare (uses archivemod)) (declare (uses apimod)) (declare (uses autoload)) (declare (uses bigmod)) (declare (uses commonmod)) (declare (uses configfmod)) (declare (uses dbmod)) (declare (uses dbi)) (declare (uses debugprint)) (declare (uses ducttape-lib)) (declare (uses ezstepsmod)) (declare (uses http-transportmod)) (declare (uses launchmod)) (declare (uses mtargs)) (declare (uses mtver)) (declare (uses mutils)) (declare (uses processmod)) (declare (uses rmtmod)) (declare (uses runsmod)) (declare (uses servermod)) (declare (uses testsmod)) ;; needed for configf scripts, scheme etc. (declare (uses apimod.import)) (declare (uses debugprint.import)) (declare (uses mtargs.import)) (declare (uses commonmod.import)) (declare (uses configfmod.import)) (declare (uses bigmod.import)) (declare (uses dbmod.import)) (declare (uses rmtmod.import)) ;; (include "call-with-environment-variables/call-with-environment-variables.scm") (module megatest-main * (import scheme chicken.base chicken.bitwise chicken.condition chicken.eval chicken.file chicken.file.posix chicken.format chicken.io chicken.irregex chicken.pathname chicken.port chicken.pretty-print chicken.process chicken.process-context chicken.process-context.posix chicken.process.signal chicken.random chicken.repl chicken.sort chicken.string chicken.tcp chicken.time chicken.time.posix (prefix base64 base64:) (prefix sqlite3 sqlite3:) (prefix sxml-modifications sxml-) address-info csv-abnf directory-utils fmt http-client intarweb json linenoise matchable md5 message-digest queues regex regex-case s11n sparse-vectors spiffy spiffy-directory-listing spiffy-request-vars sql-de-lite stack sxml-modifications sxml-serializer sxml-transforms system-information typed-records uri-common z3 srfi-1 srfi-4 srfi-18 srfi-13 srfi-98 srfi-69 |
| ︙ | ︙ | |||
124 125 126 127 128 129 130 | csv-xml ducttape-lib (prefix mtargs args:) pkts stml2 (prefix dbi dbi:) | | > | | 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | csv-xml ducttape-lib (prefix mtargs args:) pkts stml2 (prefix dbi dbi:) apimod archivemod bigmod commonmod configfmod dbmod debugprint ezstepsmod http-transportmod launchmod processmod rmtmod runsmod servermod tasksmod testsmod ) ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) |
| ︙ | ︙ | |||
2442 2443 2444 2445 2446 2447 2448 |
(repl))
(else
(begin
(set! *db* dbstruct)
;; (import extras) ;; might not be needed
;; (import csi)
;; (import readline)
| | > > > > > > > > > > > > > > > > > > > > | 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 |
(repl))
(else
(begin
(set! *db* dbstruct)
;; (import extras) ;; might not be needed
;; (import csi)
;; (import readline)
(import apropos
archivemod
commonmod
configfmod
dbmod
debugprint
ezstepsmod
http-transportmod
launchmod
processmod
rmtmod
runsmod
servermod
tasksmod
testsmod)
(set-history-length! 300)
(load-history-from-file ".megatest_history")
(current-input-port (make-linenoise-port))
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
;; (if *use-new-readline*
;; (begin
;; (install-history-file (get-environment-variable "HOME") ".megatest_history") ;; [homedir] [filename] [nlines])
;; (current-input-port (make-readline-port "megatest> ")))
;; (begin
|
| ︙ | ︙ |
Modified runsmod.scm from [8b969957a6] to [1219e25fbf].
| ︙ | ︙ | |||
42 43 44 45 46 47 48 49 50 51 52 53 54 55 | (module runsmod * (import scheme (prefix sqlite3 sqlite3:) chicken.base chicken.condition chicken.file chicken.file.posix chicken.format chicken.io chicken.pathname chicken.port chicken.pretty-print | > | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | (module runsmod * (import scheme (prefix sqlite3 sqlite3:) chicken.base chicken.condition chicken.eval chicken.file chicken.file.posix chicken.format chicken.io chicken.pathname chicken.port chicken.pretty-print |
| ︙ | ︙ | |||
2529 2530 2531 2532 2533 2534 2535 |
(exit 1)))
(set! keys (keys:config-get-fields *configdat*))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL
| | | 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 |
(exit 1)))
(set! keys (keys:config-get-fields *configdat*))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL
(runconfig (configf:read-config runconfigf #f #t environ-patt: #f env-to-use: (module-environment 'bigmod))))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
(begin
(debug:print-error 0 *default-log-port* "[" (args:get-arg "-reqtarg") "] not found in " runconfigf)
;; (if db (sqlite3:finalize! db))
(exit 1)
|
| ︙ | ︙ |
Modified testsmod.scm from [61c8f37d49] to [b61c571478].
| ︙ | ︙ | |||
36 37 38 39 40 41 42 43 44 45 46 47 48 49 | (import scheme chicken.base chicken.condition chicken.file chicken.io chicken.pathname chicken.file.posix chicken.process-context.posix chicken.format chicken.port chicken.pretty-print chicken.process chicken.process-context | > | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | (import scheme chicken.base chicken.condition chicken.file chicken.io chicken.pathname chicken.eval chicken.file.posix chicken.process-context.posix chicken.format chicken.port chicken.pretty-print chicken.process chicken.process-context |
| ︙ | ︙ | |||
1076 1077 1078 1079 1080 1081 1082 |
(else
(debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf) ;; BB: this fires
#f))))
(tcfg (if testexists
(configf:read-config test-configf #f system-allowed
environ-patt: (if system-allowed
"pre-launch-env-vars"
| | > | 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 |
(else
(debug:print 0 *default-log-port* "WARNING: testconfig file does not exist: "test-configf) ;; BB: this fires
#f))))
(tcfg (if testexists
(configf:read-config test-configf #f system-allowed
environ-patt: (if system-allowed
"pre-launch-env-vars"
#f)
env-to-use: (module-environment 'bigmod))
#f)))
(if (and tcfg cache-file) (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data
(if tcfg (hash-table-set! *testconfigs* test-full-name tcfg))
(if (and testexists
cache-file
(file-writable? cache-path)
allow-write-cache)
|
| ︙ | ︙ |