397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
|
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
|
-
+
-
-
+
+
+
+
+
-
+
|
(get-environment-variable "DASHBOARDROWS"))))
(update-rundat "%" *num-runs* "%" "%"))
(set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20)))
(define uidat #f)
;; (megatest-dashboard)
(define (run-update other-thread)
(define (run-update mtx1)
(let loop ((i 0))
(thread-sleep! 0.1)
(thread-suspend! other-thread)
(thread-sleep! 0.05)
(mutex-lock! mtx1)
(update-buttons uidat *num-runs* *num-tests*)
(mutex-unlock! mtx1)
(iup:main-loop-flush)
(mutex-lock! mtx1)
(update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
(hash-table-ref/default *searchpatts* "test-name" "%")
(hash-table-ref/default *searchpatts* "item-name" "%"))
(thread-resume! other-thread)
(mutex-unlock! mtx1)
(loop i)))
(define *job* #f)
(cond
((args:get-arg "-run")
(let ((runid (string->number (args:get-arg "-run"))))
|
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
|
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
|
-
+
|
; (exit)))
(examine-test *db* testid mx1)))
(begin
(print "ERROR: testid is not a number " (args:get-arg "-test"))
(exit 1)))))
(else
(set! uidat (make-dashboard-buttons *num-runs* *num-tests* dbkeys))
(set! *job* (lambda (thr)(run-update thr)))))
(set! *job* (lambda (mtx1)(run-update mtx1)))))
(let* ((mx1 (make-mutex))
(th2 (make-thread iup:main-loop))
(th1 (make-thread (*job* mx1))))
(thread-start! th1)
(thread-start! th2)
(thread-join! th2))
|