Overview
| Comment: | Fixed silly ; bug in env2file and added -server/-var for lookups in configs |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.55 |
| Files: | files | file ages | folders |
| SHA1: |
9b39882f8664c8e83e00f40dedb42f0c |
| User & Date: | matt on 2014-04-07 18:53:21 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-04-07
| ||
| 18:59 | Don't put out empty string on no value found check-in: 508f94e08b user: matt tags: v1.55 | |
| 18:53 | Fixed silly ; bug in env2file and added -server/-var for lookups in configs check-in: 9b39882f86 user: matt tags: v1.55 | |
|
2014-04-03
| ||
| 21:18 | Fixed some minor issues identified by compiling with master branch of Chicken. check-in: abbee5328d user: matt tags: v1.55 | |
Changes
Modified common.scm from [1ffef387ac] to [5bf9168feb].
| ︙ | ︙ | |||
346 347 348 349 350 351 352 |
(uname #f))
(if (null? (car uname-res))
"unknown"
(caar uname-res))))
(define (save-environment-as-files fname #!key (ignorevars (list "USER" "HOME" "DISPLAY" "LS_COLORS" "XKEYSYMDB" "EDITOR")))
(let ((envvars (get-environment-variables))
| | | | | > > | | | > > | | 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 |
(uname #f))
(if (null? (car uname-res))
"unknown"
(caar uname-res))))
(define (save-environment-as-files fname #!key (ignorevars (list "USER" "HOME" "DISPLAY" "LS_COLORS" "XKEYSYMDB" "EDITOR")))
(let ((envvars (get-environment-variables))
(whitesp (regexp "[^a-zA-Z0-9_\\-:,.\\/%$]")))
(with-output-to-file (conc fname ".csh")
(lambda ()
(for-each (lambda (keyval)
(let* ((key (car keyval))
(val (cdr keyval))
(delim (if (string-search whitesp val)
"\""
"")))
(print (if (member key ignorevars)
"# setenv "
"setenv ")
key " " delim val delim)))
envvars)))
(with-output-to-file (conc fname ".sh")
(lambda ()
(for-each (lambda (keyval)
(let* ((key (car keyval))
(val (cdr keyval))
(delim (if (string-search whitesp val)
"\""
"")))
(print (if (member key ignorevars)
"# export "
"export ")
key "=" delim val delim)))
envvars)))))
;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
(define (alist->env-vars lst)
(if (list? lst)
(let ((res '()))
|
| ︙ | ︙ |
Modified megatest.scm from [3dab83a5af] to [572987f97e].
| ︙ | ︙ | |||
106 107 108 109 110 111 112 113 114 115 116 117 118 119 | -list-disks : list the disks available for storing runs -list-targets : list the targets in runconfigs.config -list-db-targets : list the target combinations used in the db -show-config : dump the internal representation of the megatest.config file -show-runconfig : dump the internal representation of the runconfigs.config file -dumpmode json : dump in json format instead of sexpr -show-cmdinfo : dump the command info for a test (run in test environment) Misc -start-dir path : switch to this directory before running megatest -rebuild-db : bring the database schema up to date -cleanup-db : remove any orphan records, vacuum the db -update-meta : update the tests metadata for all tests -env2file fname : write the environment to fname.csh and fname.sh | > > | 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | -list-disks : list the disks available for storing runs -list-targets : list the targets in runconfigs.config -list-db-targets : list the target combinations used in the db -show-config : dump the internal representation of the megatest.config file -show-runconfig : dump the internal representation of the runconfigs.config file -dumpmode json : dump in json format instead of sexpr -show-cmdinfo : dump the command info for a test (run in test environment) -section sectionName -var varName : for config and runconfig lookup value for sectionName varName Misc -start-dir path : switch to this directory before running megatest -rebuild-db : bring the database schema up to date -cleanup-db : remove any orphan records, vacuum the db -update-meta : update the tests metadata for all tests -env2file fname : write the environment to fname.csh and fname.sh |
| ︙ | ︙ | |||
199 200 201 202 203 204 205 206 207 208 209 210 211 212 | "-set-state-status" "-set-run-status" "-debug" ;; for *verbosity* > 2 "-gen-megatest-test" "-override-timeout" "-test-files" ;; -test-paths is for listing all "-load" ;; load and exectute a scheme file "-dumpmode" ) (list "-h" "-version" "-force" "-xterm" "-showkeys" | > > | 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 | "-set-state-status" "-set-run-status" "-debug" ;; for *verbosity* > 2 "-gen-megatest-test" "-override-timeout" "-test-files" ;; -test-paths is for listing all "-load" ;; load and exectute a scheme file "-section" "-var" "-dumpmode" ) (list "-h" "-version" "-force" "-xterm" "-showkeys" |
| ︙ | ︙ | |||
475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 |
(if (args:get-arg "-show-runconfig")
(let ((tl (setup-for-run)))
(push-directory *toppath*)
(let ((data (full-runconfigs-read)))
;; keep this one local
(cond
((not (args:get-arg "-dumpmode"))
(pp (hash-table->alist data)))
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
(else
(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
(set! *didsomething* #t))
(pop-directory)))
(if (args:get-arg "-show-config")
(let ((tl (setup-for-run))
(data *configdat*)) ;; (read-config "megatest.config" #f #t)))
(push-directory *toppath*)
;; keep this one local
(cond
((not (args:get-arg "-dumpmode"))
(pp (hash-table->alist data)))
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
(else
(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
(set! *didsomething* #t)
| > > > > > > | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 |
(if (args:get-arg "-show-runconfig")
(let ((tl (setup-for-run)))
(push-directory *toppath*)
(let ((data (full-runconfigs-read)))
;; keep this one local
(cond
((and (args:get-arg "-section")
(args:get-arg "-var"))
(print (configf:lookup data (args:get-arg "-section")(args:get-arg "-var"))))
((not (args:get-arg "-dumpmode"))
(pp (hash-table->alist data)))
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
(else
(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
(set! *didsomething* #t))
(pop-directory)))
(if (args:get-arg "-show-config")
(let ((tl (setup-for-run))
(data *configdat*)) ;; (read-config "megatest.config" #f #t)))
(push-directory *toppath*)
;; keep this one local
(cond
((and (args:get-arg "-section")
(args:get-arg "-var"))
(print (configf:lookup data (args:get-arg "-section")(args:get-arg "-var"))))
((not (args:get-arg "-dumpmode"))
(pp (hash-table->alist data)))
((string=? (args:get-arg "-dumpmode") "json")
(json-write data))
(else
(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
(set! *didsomething* #t)
|
| ︙ | ︙ |