416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
|
;;======================================================================
;;
;;======================================================================
(define (examine-test run-id test-id) ;; run-id run-key origtest)
(let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db"))
(dbstruct (make-dbr:dbstruct path: (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree")
local: #t))
(testdat (db:get-test-info-by-id dbstruct run-id test-id))
(db-mod-time 0) ;; (file-modification-time db-path))
(last-update 0) ;; (current-seconds))
(request-update #t))
(if (not testdat)
(begin
(debug:print 2 "ERROR: No test data found for test " test-id ", exiting")
(exit 1))
(let* (;; (run-id (if testdat (db:test-get-run_id testdat) #f))
(test-registry (tests:get-all))
(keydat (if testdat (db:get-key-val-pairs dbstruct run-id) #f))
(rundat (if testdat (db:get-run-info dbstruct run-id) #f))
(runname (if testdat (db:get-value-by-header (db:get-rows rundat)
(db:get-header rundat)
"runname") #f))
;; (tdb (tdb:open-test-db-by-test-id-local dbstruct run-id test-id))
;; 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 (if testdat
(db:test-get-rundir testdat)
logfile))
;; (testdat-path (conc rundir "/testdat.db")) ;; this gets recalculated until found
(teststeps (if testdat (tests:get-compressed-steps dbstruct run-id test-id) '()))
(testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
(testname (if testdat (db:test-get-testname testdat) "n/a"))
;; (tests:get-testconfig testdat testname 'return-procs))
(testmeta (if testdat
(let ((tm (db:testmeta-get-record dbstruct testname)))
(if tm tm (make-db:testmeta)))
(make-db:testmeta)))
(keystring (string-intersperse
(map (lambda (keyval)
;; (conc ":" (car keyval) " " (cadr keyval)))
(cadr keyval))
|
|
|
|
|
|
|
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
|
;;======================================================================
;;
;;======================================================================
(define (examine-test run-id test-id) ;; run-id run-key origtest)
(let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db"))
(dbstruct (make-dbr:dbstruct path: (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree")
local: #t))
(testdat (rmt:get-test-info-by-id run-id test-id)) ;; (db:get-test-info-by-id dbstruct run-id test-id))
(db-mod-time 0) ;; (file-modification-time db-path))
(last-update 0) ;; (current-seconds))
(request-update #t))
(if (not testdat)
(begin
(debug:print 2 "ERROR: No test data found for test " test-id ", exiting")
(exit 1))
(let* (;; (run-id (if testdat (db:test-get-run_id testdat) #f))
(test-registry (tests:get-all))
(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-rows rundat)
(db:get-header rundat)
"runname") #f))
;; (tdb (tdb:open-test-db-by-test-id-local dbstruct run-id test-id))
;; 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 (if testdat
(db:test-get-rundir testdat)
logfile))
;; (testdat-path (conc rundir "/testdat.db")) ;; this gets recalculated until found
(teststeps (if testdat (tests:get-compressed-steps #f run-id test-id) '()))
(testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
(testname (if testdat (db:test-get-testname testdat) "n/a"))
;; (tests:get-testconfig testdat testname 'return-procs))
(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))
|
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
|
(> (current-milliseconds)(+ last-update 10000)) ;; force update even 10 seconds
request-update))
(newtestdat (if need-update
;; NOTE: BUG HIDER, try to eliminate this exception handler
(handle-exceptions
exn
(debug:print-info 0 "test db access issue in examine test for run-id " run-id ", test-id " test-id ": " ((condition-property-accessor 'exn 'message) exn))
(db:get-test-info-by-id dbstruct run-id test-id )))))
;; (debug:print-info 0 "need-update= " need-update " curr-mod-time = " curr-mod-time)
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (tests:get-compressed-steps dbstruct run-id test-id))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
(set! rundir ;; (filedb:get-path *fdb*
(db:test-get-rundir testdat)) ;; )
(set! testfullname (db:test-get-fullname testdat))
;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n "))
;; I don't see why this was implemented this way. Please comment it ...
|
|
|
|
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
|
(> (current-milliseconds)(+ last-update 10000)) ;; force update even 10 seconds
request-update))
(newtestdat (if need-update
;; NOTE: BUG HIDER, try to eliminate this exception handler
(handle-exceptions
exn
(debug:print-info 0 "test db access issue in examine test for run-id " run-id ", test-id " test-id ": " ((condition-property-accessor 'exn 'message) exn))
(rmt:get-test-info-by-id run-id test-id )))))
;; (debug:print-info 0 "need-update= " need-update " curr-mod-time = " curr-mod-time)
(cond
((and need-update newtestdat)
(set! testdat newtestdat)
(set! teststeps (tests:get-compressed-steps #f run-id test-id))
(set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
(set! rundir ;; (filedb:get-path *fdb*
(db:test-get-rundir testdat)) ;; )
(set! testfullname (db:test-get-fullname testdat))
;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n "))
;; I don't see why this was implemented this way. Please comment it ...
|
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
|
(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)))
(db:read-test-data dbstruct run-id 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")
|
|
|
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
|
(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 run-id 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")
|