786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
|
;; We are about to actually kick off the test
;; so this is a good place to remove the records for
;; any previous runs
;; (db:test-remove-steps db run-id testname itemdat)
;; now is also a good time to write the .testconfig file
(let* ((tconfig-fname (conc work-area "/.testconfig"))
(tconfig-tmpfile (conc tconfig-fname ".tmp"))
(tconfig (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t))) ;; 'return-procs)))
(configf:write-alist tconfig tconfig-tmpfile)
(file-move tconfig-tmpfile tconfig-fname #t)
(delete-file* ".final-status"))
;;
(let* ((m (make-mutex))
(kill-job? #f)
(exit-info (make-launch:einf pid: #t exit-status: #t exit-code: #t rollup-status: 0)) ;; pid exit-status exit-code (i.e. process was successfully run) rollup-status
(job-thread #f)
;; (keep-going #t)
(misc-flags (let ((ht (make-hash-table)))
|
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
|
;; We are about to actually kick off the test
;; so this is a good place to remove the records for
;; any previous runs
;; (db:test-remove-steps db run-id testname itemdat)
;; now is also a good time to write the .testconfig file
(let* ((tconfig-fname (conc work-area "/.testconfig"))
(tconfig-tmpfile (conc tconfig-fname ".tmp"))
(tconfig (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t)) ;; 'return-procs)))
(scripts (configf:get-section tconfig "scripts")))
;; create .testconfig file
(configf:write-alist tconfig tconfig-tmpfile)
(file-move tconfig-tmpfile tconfig-fname #t)
(delete-file* ".final-status")
;; extract scripts from testconfig and write them to files in test run dir
(for-each
(lambda (scriptdat)
(match scriptdat
((name content)
(with-output-to-file name
(lambda ()
(print content)
(change-file-mode name (bitwise-ior perm/irwxg perm/irwxu)))))
(else
(debug:print-info 0 "Invalid script definiton found in [scripts] section of testconfig. \"" scriptdat "\""))))
scripts))
;;
(let* ((m (make-mutex))
(kill-job? #f)
(exit-info (make-launch:einf pid: #t exit-status: #t exit-code: #t rollup-status: 0)) ;; pid exit-status exit-code (i.e. process was successfully run) rollup-status
(job-thread #f)
;; (keep-going #t)
(misc-flags (let ((ht (make-hash-table)))
|