353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
|
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
|
-
+
+
|
(debug:print 0 "WARNING: Max running jobs exceeded, current number running: " num-running
", max_concurrent_jobs: " max-concurrent-jobs)
#f)))))
(define (run-tests db test-names)
(let* ((keys (db-get-keys db))
(keyvallst (keys->vallist keys #t))
(run-id (register-run db keys))) ;; test-name)))
(run-id (register-run db keys)) ;; test-name)))
(deferred '())) ;; delay running these since they have a waiton clause
;; on the first pass or call to run-tests set FAILS to NOT_STARTED if
;; -keepgoing is specified
(if (and (eq? *passnum* 0)
(args:get-arg "-keepgoing"))
(begin
;; have to delete test records where NOT_STARTED since they can cause -keepgoing to
;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends
|
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
|
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
|
+
+
-
+
|
(debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override"))
(let* ((get-prereqs-cmd (lambda ()
(db-get-prereqs-not-met db run-id waiton))) ;; check before running ....
(launch-cmd (lambda ()
(launch-test db run-id test-conf keyvallst test-name test-path itemdat)))
(testrundat (list get-prereqs-cmd launch-cmd)))
(if (or (args:get-arg "-force")
(let ((preqs-not-yet-met ((car testrundat))))
(debug:print 2 "Preqrequesites for " test-name ": " preqs-not-yet-met)
(null? ((car testrundat)))) ;; are there any tests that must be run before this one...
(null? preqs-not-yet-met))) ;; are there any tests that must be run before this one...
(if (not ((cadr testrundat))) ;; this is the line that launches the test to the remote host
(begin
(print "ERROR: Failed to launch the test. Exiting as soon as possible")
(set! *globalexitstatus* 1) ;;
(process-signal (current-process-id) signal/kill)
;(exit 1)
))
|