18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
(require-library stml)
(declare (unit tests))
(declare (uses lock-queue))
(declare (uses db))
(declare (uses tdb))
(declare (uses common))
(declare (uses dcommon)) ;; needed for the steps processing
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
|
|
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
(require-library stml)
(declare (unit tests))
(declare (uses lock-queue))
(declare (uses db))
(declare (uses tdb))
(declare (uses common))
;; (declare (uses dcommon)) ;; needed for the steps processing
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
|
389
390
391
392
393
394
395
396
397
398
399
400
401
402
|
))
(close-output-port oup)
(lock-queue:release-lock outputfilename test-id)
(change-directory orig-dir)
;; NB// tests:test-set-toplog! is remote internal...
(tests:test-set-toplog! run-id test-name outputfilename)
)))))))
;; summarize test
(define (tests:summarize-test run-id test-id)
(let* ((test-dat (rmt:get-test-info-by-id run-id test-id))
(steps-dat (rmt:get-steps-for-test run-id test-id))
(test-name (db:test-get-testname test-dat))
(item-path (db:test-get-item-path test-dat))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
389
390
391
392
393
394
395
396
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
423
424
425
426
427
428
429
430
431
432
433
434
|
))
(close-output-port oup)
(lock-queue:release-lock outputfilename test-id)
(change-directory orig-dir)
;; NB// tests:test-set-toplog! is remote internal...
(tests:test-set-toplog! run-id test-name outputfilename)
)))))))
;; temporarily passing in dbstruct to support direct access (i.e. bypassing servers)
;;
(define (tests:get-compressed-steps dbstruct run-id test-id)
(let* ((steps-data (if dbstruct
(db:get-steps-for-test dbstruct run-id test-id)
(rmt:get-steps-for-test run-id test-id)))
(comprsteps (dcommon:process-steps-table steps-data))) ;; (open-run-close db:get-steps-table #f test-id work-area: work-area)))
(map (lambda (x)
;; take advantage of the \n on time->string
(vector
(vector-ref x 0)
(let ((s (vector-ref x 1)))
(if (number? s)(seconds->time-string s) s))
(let ((s (vector-ref x 2)))
(if (number? s)(seconds->time-string s) s))
(vector-ref x 3) ;; status
(vector-ref x 4)
(vector-ref x 5))) ;; time delta
(sort (hash-table-values comprsteps)
(lambda (a b)
(let ((time-a (vector-ref a 1))
(time-b (vector-ref b 1)))
(if (and (number? time-a)(number? time-b))
(if (< time-a time-b)
#t
(if (eq? time-a time-b)
(string<? (conc (vector-ref a 2))
(conc (vector-ref b 2)))
#f))
(string<? (conc time-a)(conc time-b)))))))))
;; summarize test
(define (tests:summarize-test run-id test-id)
(let* ((test-dat (rmt:get-test-info-by-id run-id test-id))
(steps-dat (rmt:get-steps-for-test run-id test-id))
(test-name (db:test-get-testname test-dat))
(item-path (db:test-get-item-path test-dat))
|