Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v2.01-local-mtfiles | v2.01-try-1 |
Files: | files | file ages | folders |
SHA1: |
a42ae2762bd4b02eb05a68a1328fab11 |
User & Date: | bjbarcla on 2019-01-17 15:43:20 |
Other Links: | branch diff | manifest | tags |
Context
2019-01-17
| ||
18:10 | closing work for now on this branch; see wiki page v2.0-modularization-SOTU in this repo for braindump on status Leaf check-in: 76eb89ed59 user: bjbarcla tags: v2.01-local-mtfiles, v2.01-try-1 | |
15:43 | wip check-in: a42ae2762b user: bjbarcla tags: v2.01-local-mtfiles, v2.01-try-1 | |
2019-01-07
| ||
17:21 | updated repository-path to work for any chicken number check-in: 831718d65c user: bjbarcla tags: v2.01-local-mtfiles, v2.01-try-1 | |
Changes
Modified launch.scm from [fff95c3307] to [402a06e547].
︙ | ︙ | |||
70 71 72 73 74 75 76 | ;; return (conc status ": " comment) from the final section so that ;; the comment can be set in the step record in launch.scm ;; (define (launch:load-logpro-dat run-id test-id stepname) (let ((cname (conc stepname ".dat"))) (if (common:file-exists? cname) | | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | ;; return (conc status ": " comment) from the final section so that ;; the comment can be set in the step record in launch.scm ;; (define (launch:load-logpro-dat run-id test-id stepname) (let ((cname (conc stepname ".dat"))) (if (common:file-exists? cname) (let* ((dat (configf:read-config cname #f #f keep-filenames: (debug:debug-mode 9))) (csvr (db:logpro-dat->csv dat stepname)) (csvt (let-values (((fmt-cell fmt-record fmt-csv) (make-format ","))) (fmt-csv (map list->csv-record csvr)))) (status (configf:lookup dat "final" "exit-status")) (msg (configf:lookup dat "final" "message"))) (if csvt ;; this if blocked stack dump caused by .dat file from logpro being 0-byte. fixed by upgrading logpro (rmt:csv->test-data run-id test-id csvt) |
︙ | ︙ | |||
644 645 646 647 648 649 650 | (change-directory *toppath*) ;; NOTE: Current order is to process runconfigs *before* setting the MT_ vars. This ;; seems non-ideal but could well break stuff ;; BUG? BUG? BUG? (let ((rconfig (full-runconfigs-read)) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: (list "default" target)))) | | | 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 | (change-directory *toppath*) ;; NOTE: Current order is to process runconfigs *before* setting the MT_ vars. This ;; seems non-ideal but could well break stuff ;; BUG? BUG? BUG? (let ((rconfig (full-runconfigs-read)) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: (list "default" target)))) (wconfig (configf:read-config "waivers.config" #f #t sections: `( "default" ,target ) keep-filenames: (debug:debug-mode 9)))) ;; read the waivers config if it exists ;; (setup-env-defaults (conc *toppath* "/runconfigs.config") run-id (make-hash-table) keyvals target) ;; (set-run-config-vars run-id keyvals target) ;; (db:get-target db run-id)) ;; Now have runconfigs data loaded, set environment vars (for-each (lambda (section) (for-each (lambda (varval) |
︙ | ︙ | |||
876 877 878 879 880 881 882 | ;; returns: ;; *toppath* ;; side effects: ;; sets; *configdat* (megatest.config info) ;; *runconfigdat* (runconfigs.config info) ;; *configstatus* (status of the read data) ;; | | | | 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 | ;; returns: ;; *toppath* ;; side effects: ;; sets; *configdat* (megatest.config info) ;; *runconfigdat* (runconfigs.config info) ;; *configstatus* (status of the read data) ;; (define (launch:setup #!key (force-reread #f) (areapath #f) (keep-filenames #f)) (mutex-lock! *launch-setup-mutex*) (if (and *toppath* (eq? *configstatus* 'fulldata) (not force-reread)) ;; got it all (begin (debug:print 2 *default-log-port* "NOTE: skipping launch:setup-body call since we have fulldata") (mutex-unlock! *launch-setup-mutex*) *toppath*) (let ((res (launch:setup-body force-reread: force-reread areapath: areapath keep-filenames: keep-filenames))) (mutex-unlock! *launch-setup-mutex*) res))) ;; return paths depending on what info is available. ;; (define (launch:get-cache-file-paths areapath toppath target mtconfig) (let* ((use-cache (common:use-cache?)) |
︙ | ︙ | |||
915 916 917 918 919 920 921 | "\n rundir=" rundir "\n testdir=" testdir "\n cachedir=" cachedir "\n mtcachef=" mtcachef "\n rccachef=" rccachef) (cons mtcachef rccachef))) | | > | | 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 | "\n rundir=" rundir "\n testdir=" testdir "\n cachedir=" cachedir "\n mtcachef=" mtcachef "\n rccachef=" rccachef) (cons mtcachef rccachef))) (define (launch:setup-body #!key (force-reread #f) (areapath #f)(keep-filenames #f)) (if (and (eq? *configstatus* 'fulldata) *toppath* (not force-reread)) ;; no need to reprocess *toppath* ;; return toppath (let* ((use-cache (and (not keep-filenames) (common:use-cache?))) ;; BB- use-cache checks *configdat* for use-cache setting. We do not have *configdat*. Bootstrapping problem here. (toppath (or *toppath* areapath (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath (target (common:args-get-target)) (sections (if target (list "default" target) #f)) ;; for runconfigs (mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config (cachefiles (launch:get-cache-file-paths areapath toppath target mtconfig)) ;; checking for null cachefiles should not be necessary, I was seeing error car of '(), might be a chicken bug or a red herring ... (mtcachef (if (null? cachefiles) |
︙ | ︙ | |||
962 963 964 965 966 967 968 | mtcachef rccachef) ;; BB- why are we doing this without asking if caching is desired? ;;(BB> "launch:setup-body -- cond branch 2") (let* ((first-pass (configf:find-and-read-config ;; NB// sets MT_RUN_AREA_HOME as side effect mtconfig environ-patt: "env-override" given-toppath: toppath | | > > | > > | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 | mtcachef rccachef) ;; BB- why are we doing this without asking if caching is desired? ;;(BB> "launch:setup-body -- cond branch 2") (let* ((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" keep-filenames: keep-filenames )) (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 keep-filenames: keep-filenames )))) (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) |
︙ | ︙ | |||
998 999 1000 1001 1002 1003 1004 | ; (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 | | > > | > > | 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 | ; (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" keep-filenames: (debug:debug-mode 9)) ) (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 keep-filenames: (debug:debug-mode 9) ))) (cachefiles (launch:get-cache-file-paths areapath toppath target mtconfig)) (mtcachef (car cachefiles)) (rccachef (cdr cachefiles))) ;; trap exception due to stale NFS handle -- Error: (open-output-file) cannot open file - Stale NFS file handle: "/p/fdk/gwa/lefkowit/mtTesting/qa/primbeqa/links/p1222/11/PDK_r1.1.1/prim/clean/pcell_testgen/.runconfigs.cfg-1.6427-7d1e789cb3f62f9cde719a4865bb51b3c17ea853" - ticket 220546342 ;; TODO - consider 1) using simple-lock to bracket cache write ;; 2) cache in hash on server, since need to do rmt: anyway to lock. |
︙ | ︙ | |||
1036 1037 1038 1039 1040 1041 1042 | ;; 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") | | > > | > > | 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 | ;; 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" keep-filenames: keep-filenames ))) (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 keep-filenames: (debug:debug-mode 9) ))) (set! *configinfo* cfgdat) (set! *configdat* (car cfgdat)) (set! *runconfigdat* rdat) (set! *toppath* toppath) (set! *configstatus* 'partial)) (begin (debug:print-error 0 *default-log-port* "No " mtconfig " file found. Giving up.") |
︙ | ︙ | |||
1114 1115 1116 1117 1118 1119 1120 | (if (and rccachef mtcachef *runconfigdat* *configdat*) (set! *configstatus* 'fulldata))) ;; if have -append-config then read and append here (let ((cfname (args:get-arg "-append-config"))) (if (and cfname (file-read-access? cfname)) | | > > | 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 | (if (and rccachef mtcachef *runconfigdat* *configdat*) (set! *configstatus* 'fulldata))) ;; if have -append-config then read and append here (let ((cfname (args:get-arg "-append-config"))) (if (and cfname (file-read-access? cfname)) (configf:read-config cfname *configdat* #t keep-filenames: (debug:debug-mode 9) ))) ;; values are added to the hash, no need to do anything special. *toppath*))) (define (get-best-disk confdat testconfig) (let* ((disks (or (and testconfig (hash-table-ref/default testconfig "disks" #f)) (hash-table-ref/default confdat "disks" #f))) (minspace (let ((m (configf:lookup confdat "setup" "minspace"))) (string->number (or m "10000"))))) |
︙ | ︙ |
Modified megatest.scm from [32872ea46a] to [db6f70b9ca].
︙ | ︙ | |||
422 423 424 425 426 427 428 429 430 431 432 433 434 435 | "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only "-diff-rep" ) args:arg-hash 0)) ;; Add args that use remargs here ;; (if (and (not (null? remargs)) (not (or (args:get-arg "-runstep") (args:get-arg "-envcap") | > > > | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 | "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only "-diff-rep" ) args:arg-hash 0)) ;; ;; Add args that use remargs here ;; (if (and (not (null? remargs)) (not (or (args:get-arg "-runstep") (args:get-arg "-envcap") |
︙ | ︙ | |||
591 592 593 594 595 596 597 598 599 600 601 602 603 604 | (exit 1)))) homehost-required)))) ;;====================================================================== ;; Misc setup stuff ;;====================================================================== (debug:setup) (if (args:get-arg "-logging") (debug:add-logging-callback db:log-event)) (if (debug:debug-mode 3) ;; we are obviously debugging (set! open-run-close open-run-close-no-exception-handling)) | > > | 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 | (exit 1)))) homehost-required)))) ;;====================================================================== ;; Misc setup stuff ;;====================================================================== ;; setup modules (if (args:get-arg "-debug") (debug:set-debug-mode (args:get-arg "-debug"))) (debug:setup) (if (args:get-arg "-logging") (debug:add-logging-callback db:log-event)) (if (debug:debug-mode 3) ;; we are obviously debugging (set! open-run-close open-run-close-no-exception-handling)) |
︙ | ︙ | |||
987 988 989 990 991 992 993 | (json-write data)) (else (debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised"))) (set! *didsomething* #t)) (pop-directory))) (if (args:get-arg "-show-config") | | > | 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 | (json-write data)) (else (debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised"))) (set! *didsomething* #t)) (pop-directory))) (if (args:get-arg "-show-config") (let ((tl (launch:setup keep-filenames: (debug:debug-mode 9))) (data *configdat*)) ;; (read-config "megatest.config" #f #t))) (BB> "in -show-config: keep-filenames: "(debug:debug-mode 9)) (push-directory *toppath*) ;; keep this one local (cond ((and (args:get-arg "-section") (args:get-arg "-var")) (let ((val (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")))) (if val (print val)))) |
︙ | ︙ | |||
2153 2154 2155 2156 2157 2158 2159 | (args:get-arg "-diff-email")) (set! *didsomething* #t) (exit 0))) (if (or (getenv "MT_RUNSCRIPT") (args:get-arg "-repl") (args:get-arg "-load")) | | | 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 | (args:get-arg "-diff-email")) (set! *didsomething* #t) (exit 0))) (if (or (getenv "MT_RUNSCRIPT") (args:get-arg "-repl") (args:get-arg "-load")) (let* ((toppath (launch:setup keep-filenames: (debug:debug-mode 9))) (dbstruct (if (and toppath (common:on-homehost?)) (db:setup #t) #f))) ;; make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f))) (if *toppath* (cond ((getenv "MT_RUNSCRIPT") |
︙ | ︙ |
Modified modules.scm from [4ab26bda3c] to [22d4a2e5e1].
︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (use (prefix mtargs args:)) (use mtdebug) | > | > < | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (define (load-common-modules) (use (prefix mtargs args:)) (use mtdebug) (use (prefix mtconfigf configf:))) (load-common-modules) ;; configure mtdebug ;; TODO: move to megatest.scm with other command line arg processing (if (args:get-arg "-v") (debug:set-verbose-mode)) (if (args:get-arg "-q") (debug:set-quiet-mode)) (if (args:get-arg "-color") (case (string->symbol (args:get-arg "-color")) ((y Y yes YES t T) (debug:force-color)) ((n N no NO f F) (debug:suppress-color)))) ;; configure mtconfigf (define *default-log-port* (current-error-port)) |
︙ | ︙ |