286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
|
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
|
(pad-list *allruns* numruns)))
(lftcol (vector-ref uidat 0))
(tableheader (vector-ref uidat 1))
(table (vector-ref uidat 2))
(coln 0))
(set! *alltestnamelst* '())
;; create a concise list of test names
(for-each (lambda (rundat)
(if (vector? rundat)
(let* ((testdat (vector-ref rundat 1))
(testnames (map test:test-get-fullname testdat)))
(for-each (lambda (testname)
(if (not (member testname *alltestnamelst*))
(begin
(set! *alltestnamelst* (append *alltestnamelst* (list testname))))))
testnames))))
runs)
(for-each
(lambda (rundat)
(if (vector? rundat)
(let* ((testdat (vector-ref rundat 1))
(testnames (map test:test-get-fullname testdat)))
(for-each (lambda (testname)
(if (not (member testname *alltestnamelst*))
(begin
(set! *alltestnamelst* (append *alltestnamelst* (list testname))))))
testnames))))
runs)
(set! *alltestnamelst* (collapse-rows *alltestnamelst*)) ;;; argh. please clean up this sillyness
(set! *alltestnamelst* (let ((xl (if (> (length *alltestnamelst*) *start-test-offset*)
(drop *alltestnamelst* *start-test-offset*)
'())))
(append xl (make-list (- *num-tests* (length xl)) ""))))
(update-labels uidat)
|
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
|
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
|
+
+
+
+
+
-
+
-
-
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
+
-
-
-
-
+
+
+
+
-
-
+
+
+
+
-
-
+
+
-
-
+
-
-
-
-
|
(get-environment-variable "DASHBOARDROWS" ))
(begin
(set! *num-tests* (string->number (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS"))))
(update-rundat "%" *num-runs* "%" "%"))
(set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20)))
(define *tim* (iup:timer))
(define *ord* #f)
(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")
(define (run-update mtx1)
(define (run-update x)
(let loop ((i 0))
(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" "%"))
(mutex-unlock! mtx1)
(loop i)))
(define *job* #f)
(set! *job* (lambda (mx1)
(on-exit (lambda ()
(sqlite3:finalize! *db*)))
(examine-run *db* runid)))
(lambda (x)
(on-exit (lambda ()
(sqlite3:finalize! *db*)))
(examine-run *db* runid)))
(begin
(print "ERROR: runid is not a number " (args:get-arg "-run"))
(exit 1)))))
((args:get-arg "-test")
(let ((testid (string->number (args:get-arg "-test"))))
(if testid
(set! *job* (lambda (mx1)
(examine-test *db* testid mx1)))
(set! *job* (lambda (mtx1)(run-update mtx1)))))
(run-update x)))))
;(print x)))))
(let* ((mx1 (make-mutex))
(th2 (make-thread iup:main-loop))
(th1 (make-thread (*job* mx1))))
(thread-start! th1)
(thread-start! th2)
(thread-join! th2))
|