228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
(run-id (cdb:remote-run db:register-run #f keys keyvals runname "new" "n/a" user)) ;; test-name)))
(deferred '()) ;; delay running these since they have a waiton clause
;; keepgoing is the defacto modality now, will add hit-n-run a bit later
;; (keepgoing (hash-table-ref/default flags "-keepgoing" #f))
(runconfigf (conc *toppath* "/runconfigs.config"))
(required-tests '())
(test-records (make-hash-table))
(test-names '())
(all-test-names (tests:get-valid-tests *toppath* "%"))) ;; we need a list of all valid tests to check waiton names
(set-megatest-env-vars run-id inkeys: keys) ;; these may be needed by the launching process
(if (file-exists? runconfigf)
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keys keyvals "pre-launch-env-vars")
(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
|
|
|
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
(run-id (cdb:remote-run db:register-run #f keys keyvals runname "new" "n/a" user)) ;; test-name)))
(deferred '()) ;; delay running these since they have a waiton clause
;; keepgoing is the defacto modality now, will add hit-n-run a bit later
;; (keepgoing (hash-table-ref/default flags "-keepgoing" #f))
(runconfigf (conc *toppath* "/runconfigs.config"))
(required-tests '())
(test-records (make-hash-table))
(all-test-names (tests:get-valid-tests *toppath* "%"))) ;; we need a list of all valid tests to check waiton names)
(all-test-names (tests:get-valid-tests *toppath* "%"))) ;; we need a list of all valid tests to check waiton names
(set-megatest-env-vars run-id inkeys: keys) ;; these may be needed by the launching process
(if (file-exists? runconfigf)
(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keys keyvals "pre-launch-env-vars")
(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
|
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
|
(if (not (null? required-tests))
(debug:print-info 1 "Adding " required-tests " to the run queue"))
;; NOTE: these are all parent tests, items are not expanded yet.
(debug:print-info 4 "test-records=" (hash-table->alist test-records))
(let ((reglen (any->number (configf:lookup *configdat* "setup" "runqueue"))))
(if reglen
(runs:run-tests-queue-new run-id runname test-records flags test-patts reglen)
(runs:run-tests-queue-classic run-id runname test-records flags test-patts)))
(debug:print-info 4 "All done by here")))
(define (runs:calc-fails prereqs-not-met)
(filter (lambda (test)
(and (vector? test) ;; not (string? test))
(equal? (db:test-get-state test) "COMPLETED")
(not (member (db:test-get-status test)
|
|
|
|
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
|
(if (not (null? required-tests))
(debug:print-info 1 "Adding " required-tests " to the run queue"))
;; NOTE: these are all parent tests, items are not expanded yet.
(debug:print-info 4 "test-records=" (hash-table->alist test-records))
(let ((reglen (any->number (configf:lookup *configdat* "setup" "runqueue"))))
(if reglen
(runs:run-tests-queue-new run-id runname test-records keyvallst flags test-patts required-tests reglen)
(runs:run-tests-queue-classic run-id runname test-records keyvallst flags test-patts required-tests)))
(debug:print-info 4 "All done by here")))
(define (runs:calc-fails prereqs-not-met)
(filter (lambda (test)
(and (vector? test) ;; not (string? test))
(equal? (db:test-get-state test) "COMPLETED")
(not (member (db:test-get-status test)
|
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
|
(exit 1)))
;; (if (args:get-arg "-server")
;; (open-run-close server:start db (args:get-arg "-server")))
(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 (read-config runconfigf #f #t environ-patt: #f)))
(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 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
(if db (sqlite3:finalize! db))
(exit 1))))
|
|
|
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
|
(exit 1)))
;; (if (args:get-arg "-server")
;; (open-run-close server:start db (args:get-arg "-server")))
(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 (read-config runconfigf #f #t environ-patt: #f)))
(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 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
(if db (sqlite3:finalize! db))
(exit 1))))
|