| ︙ | | | ︙ | |
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
(if (file-exists? cname)
(let* ((dat (read-config cname #f #f))
(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)
;; (BB> "Error: run-id/test-id/stepname="run-id"/"test-id"/"stepname" => bad csvr="csvr)
;; )
|
<
|
<
<
|
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
(if (file-exists? cname)
(let* ((dat (read-config cname #f #f))
(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")))
(rmt:csv->test-data run-id test-id csvt)
(cond
((equal? status "PASS") "PASS") ;; skip the message part if status is pass
(status (conc (configf:lookup dat "final" "exit-status") ": " (if msg msg "no message")))
(else #f)))
#f)))
(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig)
|
| ︙ | | | ︙ | |
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
|
;; megatest.config (cache if all vars avail)
;; returns:
;; *toppath*
;; side effects:
;; sets; *configdat* (megatest.config info)
;; *runconfigdat* (runconfigs.config info)
;; *configstatus* (status of the read data)
;;
(define (launch:setup #!key (force #f))
(let* ((toppath (or *toppath* (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
(runname (common:args-get-runname))
(target (common:args-get-target))
(linktree (common:get-linktree))
(sections (if target (list "default" target) #f)) ;; for runconfigs
(mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config
|
|
|
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
|
;; megatest.config (cache if all vars avail)
;; returns:
;; *toppath*
;; side effects:
;; sets; *configdat* (megatest.config info)
;; *runconfigdat* (runconfigs.config info)
;; *configstatus* (status of the read data)
;; *transport-type*
(define (launch:setup #!key (force #f))
(let* ((toppath (or *toppath* (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
(runname (common:args-get-runname))
(target (common:args-get-target))
(linktree (common:get-linktree))
(sections (if target (list "default" target) #f)) ;; for runconfigs
(mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config
|
| ︙ | | | ︙ | |
832
833
834
835
836
837
838
839
840
841
842
843
844
845
|
(if (and *toppath*
(directory-exists? *toppath*))
(begin
(setenv "MT_RUN_AREA_HOME" *toppath*)
(setenv "MT_TESTSUITE_NAME" (common:get-testsuite-name)))
(begin
(debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")))
*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")))))
|
>
|
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
|
(if (and *toppath*
(directory-exists? *toppath*))
(begin
(setenv "MT_RUN_AREA_HOME" *toppath*)
(setenv "MT_TESTSUITE_NAME" (common:get-testsuite-name)))
(begin
(debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")))
(server:set-transport)
*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")))))
|
| ︙ | | | ︙ | |
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
|
(create-directory work-area #t)
(debug:print 0 *default-log-port* "WARNING: No disk work area specified - running in the test directory under tmp_run")))
(set! cmdparms (base64:base64-encode
(z3:encode-buffer
(with-output-to-string
(lambda () ;; (list 'hosts hosts)
(write (list (list 'testpath test-path)
(list 'transport (conc *transport-type*))
;; (list 'serverinf *server-info*)
(list 'toppath *toppath*)
(list 'work-area work-area)
(list 'test-name test-name)
(list 'runscript runscript)
(list 'run-id run-id )
(list 'test-id test-id )
|
|
|
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
|
(create-directory work-area #t)
(debug:print 0 *default-log-port* "WARNING: No disk work area specified - running in the test directory under tmp_run")))
(set! cmdparms (base64:base64-encode
(z3:encode-buffer
(with-output-to-string
(lambda () ;; (list 'hosts hosts)
(write (list (list 'testpath test-path)
(list 'transport (conc (rmt:run-id->transport-type run-id)))
;; (list 'serverinf *server-info*)
(list 'toppath *toppath*)
(list 'work-area work-area)
(list 'test-name test-name)
(list 'runscript runscript)
(list 'run-id run-id )
(list 'test-id test-id )
|
| ︙ | | | ︙ | |