355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
|
(db #f))
(if (not testdat)
(begin
(debug:print 0 "ERROR: No test data found for test " test-id ", exiting")
(exit 1))
(let* ((run-id (if testdat (db:test-get-run_id testdat) #f))
(keydat (if testdat (rmt:get-key-val-pairs run-id) #f))
(rundat (if testdat (cdb:remote-run db:get-run-info #f run-id) #f))
(runname (if testdat (db:get-value-by-header (db:get-row rundat)
(db:get-header rundat)
"runname") #f))
;; These next two are intentional bad values to ensure errors if they should not
;; get filled in properly.
(logfile "/this/dir/better/not/exist")
(rundir logfile)
(teststeps (if testdat (dashboard-tests:get-compressed-steps test-id work-area: rundir) '()))
(testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
(testname (if testdat (db:test-get-testname testdat) "n/a"))
(testmeta (if testdat
(let ((tm (cdb:remote-run db:testmeta-get-record #f testname)))
(if tm tm (make-db:testmeta)))
(make-db:testmeta)))
(keystring (string-intersperse
(map (lambda (keyval)
;; (conc ":" (car keyval) " " (cadr keyval)))
(cadr keyval))
|
|
|
|
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
|
(db #f))
(if (not testdat)
(begin
(debug:print 0 "ERROR: No test data found for test " test-id ", exiting")
(exit 1))
(let* ((run-id (if testdat (db:test-get-run_id testdat) #f))
(keydat (if testdat (rmt:get-key-val-pairs run-id) #f))
(rundat (if testdat (rmt:get-run-info run-id) #f))
(runname (if testdat (db:get-value-by-header (db:get-row rundat)
(db:get-header rundat)
"runname") #f))
;; These next two are intentional bad values to ensure errors if they should not
;; get filled in properly.
(logfile "/this/dir/better/not/exist")
(rundir logfile)
(teststeps (if testdat (dashboard-tests:get-compressed-steps test-id work-area: rundir) '()))
(testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
(testname (if testdat (db:test-get-testname testdat) "n/a"))
(testmeta (if testdat
(let ((tm (rmt:testmeta-get-record testname)))
(if tm tm (make-db:testmeta)))
(make-db:testmeta)))
(keystring (string-intersperse
(map (lambda (keyval)
;; (conc ":" (car keyval) " " (cadr keyval)))
(cadr keyval))
|
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
|
(need-update (or (and (> curr-mod-time db-mod-time)
(> (current-seconds) (+ last-update 2))) ;; every two seconds if db touched
request-update))
(newtestdat (if need-update
(handle-exceptions
exn
(debug:print-info 2 "test db access issue: " ((condition-property-accessor 'exn 'message) exn))
(cdb:remote-run db:get-test-info-by-id #f test-id )))))
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (dashboard-tests:get-compressed-steps test-id work-area: rundir))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
(set! rundir (db:test-get-rundir testdat))
(set! testfullname (db:test-get-fullname testdat))
|
|
|
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
|
(need-update (or (and (> curr-mod-time db-mod-time)
(> (current-seconds) (+ last-update 2))) ;; every two seconds if db touched
request-update))
(newtestdat (if need-update
(handle-exceptions
exn
(debug:print-info 2 "test db access issue: " ((condition-property-accessor 'exn 'message) exn))
(rmt:get-test-info-by-id test-id )))))
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (dashboard-tests:get-compressed-steps test-id work-area: rundir))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
(set! rundir (db:test-get-rundir testdat))
(set! testfullname (db:test-get-fullname testdat))
|
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
|
(db:test-data-get-value x)
(db:test-data-get-expected x)
(db:test-data-get-tol x)
(db:test-data-get-status x)
(db:test-data-get-units x)
(db:test-data-get-type x)
(db:test-data-get-comment x)))
(cdb:remote-run db:read-test-data #f test-id "%")))
"\n")))
(if (not (equal? currval newval))
(iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
test-data))
;;(dashboard:run-controls)
)))
(iup:attribute-set! tabs "TABTITLE0" "Steps")
|
|
|
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
|
(db:test-data-get-value x)
(db:test-data-get-expected x)
(db:test-data-get-tol x)
(db:test-data-get-status x)
(db:test-data-get-units x)
(db:test-data-get-type x)
(db:test-data-get-comment x)))
(rmt:read-test-data test-id "%")))
"\n")))
(if (not (equal? currval newval))
(iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
test-data))
;;(dashboard:run-controls)
)))
(iup:attribute-set! tabs "TABTITLE0" "Steps")
|