Megatest

Diff
Login

Differences From Artifact [482f7844a7]:

To Artifact [1b01ab0bb7]:


258
259
260
261
262
263
264

265
266
267
268
269
270
271
		    (string->number max-concurrent-jobs)
		    (not (> num-running (string->number max-concurrent-jobs)))))
	   (run-one-test db test-name)
	   (print "WARNING: Max running jobs exceeded, current number running: " num-running 
		  ", max_concurrent_jobs: " max-concurrent-jobs))))
   test-names))


(define (run-one-test db test-name)
  (print "Launching test " test-name)
  (let* ((test-path    (conc *toppath* "/tests/" test-name))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (test-conf    (if testexists (read-config test-configf) (make-hash-table)))
	 (waiton       (let ((w (config-lookup test-conf "requirements" "waiton")))







>







258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
		    (string->number max-concurrent-jobs)
		    (not (> num-running (string->number max-concurrent-jobs)))))
	   (run-one-test db test-name)
	   (print "WARNING: Max running jobs exceeded, current number running: " num-running 
		  ", max_concurrent_jobs: " max-concurrent-jobs))))
   test-names))

;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc
(define (run-one-test db test-name)
  (print "Launching test " test-name)
  (let* ((test-path    (conc *toppath* "/tests/" test-name))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (test-conf    (if testexists (read-config test-configf) (make-hash-table)))
	 (waiton       (let ((w (config-lookup test-conf "requirements" "waiton")))
279
280
281
282
283
284
285

286
287
288
289
290
291
292
	       (keys        (db-get-keys db))
	       (keyvallst   (keys->vallist keys #t))
	       (items       (hash-table-ref/default test-conf "items" #f))
	       (allitems    (item-assoc->item-list items))
	       (run-id      (register-run db keys)) ;;  test-name)))
	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
	  ;; (print "items: ")(pp allitems)

	  (if (args:get-arg "-m")
	      (db:set-comment-for-run db run-id (args:get-arg "-m")))
	  (let loop ((itemdat (car allitems))
		     (tal     (cdr allitems)))
	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))







>







280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
	       (keys        (db-get-keys db))
	       (keyvallst   (keys->vallist keys #t))
	       (items       (hash-table-ref/default test-conf "items" #f))
	       (allitems    (item-assoc->item-list items))
	       (run-id      (register-run db keys)) ;;  test-name)))
	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
	  ;; (print "items: ")(pp allitems)
	  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
	  (if (args:get-arg "-m")
	      (db:set-comment-for-run db run-id (args:get-arg "-m")))
	  (let loop ((itemdat (car allitems))
		     (tal     (cdr allitems)))
	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))