| ︙ | | | ︙ | |
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
;;======================================================================
(declare (unit testsmod))
(declare (uses mtargs))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses itemsmod))
(declare (uses rmtmod))
(module testsmod
*
(import scheme
chicken.base
chicken.condition
chicken.file
chicken.io
chicken.pathname
chicken.port
chicken.pretty-print
chicken.process
chicken.process-context
chicken.sort
chicken.string
chicken.time
(prefix base64 base64:)
(prefix dbi dbi:)
(prefix sqlite3 sqlite3:)
(srfi 18)
directory-utils
format
matchable
|
>
>
>
>
>
>
>
>
>
|
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
;;======================================================================
(declare (unit testsmod))
(declare (uses mtargs))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses itemsmod))
(declare (uses rmtmod))
(declare (uses http-transportmod))
(declare (uses stml2))
(declare (uses dbmod))
(declare (uses tasksmod))
(module testsmod
*
(import scheme
chicken.base
chicken.condition
chicken.file
chicken.io
chicken.pathname
chicken.file.posix
chicken.process-context.posix
chicken.format
chicken.port
chicken.pretty-print
chicken.process
chicken.process-context
chicken.sort
chicken.string
chicken.time
chicken.random
(prefix base64 base64:)
(prefix dbi dbi:)
(prefix sqlite3 sqlite3:)
(srfi 18)
directory-utils
format
matchable
|
| ︙ | | | ︙ | |
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
srfi-13
srfi-69
stack
typed-records
z3
debugprint
mtargs
commonmod
pkts
itemsmod
rmtmod
)
;;======================================================================
;; Tests
;;======================================================================
|
|
>
>
>
>
>
|
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
srfi-13
srfi-69
stack
typed-records
z3
debugprint
(prefix mtargs args:)
commonmod
pkts
itemsmod
rmtmod
http-transportmod
configfmod
stml2
dbmod
tasksmod
)
;;======================================================================
;; Tests
;;======================================================================
|
| ︙ | | | ︙ | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
;;
;; (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
;; (import (prefix sqlite3 sqlite3:))
;; (require-library stml)
;;
;; (include "common_records.scm")
;; (include "key_records.scm")
;; (include "db_records.scm")
;; (include "test_records.scm")
|
|
|
|
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
;;
;; (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
;; (import (prefix sqlite3 sqlite3:))
;; (require-library stml)
;;
;; (include "common_records.scm")
;; (include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
(include "js-path.scm")
(define (init-java-script-lib)
(set! *java-script-lib* (conc (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js"))
)
;; Call this one to do all the work and get a standardized list of tests
|
| ︙ | | | ︙ | |
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
|
;;======================================================================
(define (test:archive db test-id)
#f)
(define (test:archive-tests db keynames target)
#f)
)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
|
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
|
;;======================================================================
(define (test:archive db test-id)
#f)
(define (test:archive-tests db keynames target)
#f)
;; summarize test in to a file test-summary.html in the test directory
;;
(define (tests:summarize-test run-id test-id)
(let* ((test-dat (rmt:get-test-info-by-id run-id test-id))
(out-dir (db:test-get-rundir test-dat))
(out-file (conc out-dir "/test-summary.html")))
;; first verify we are able to write the output file
(if (not (file-writable? out-dir))
(debug:print 0 *default-log-port* "ERROR: cannot write test-summary.html to " out-dir)
(let* (;; (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))
(full-name (db:test-make-full-name test-name item-path))
(oup (open-output-file out-file))
(status (db:test-get-status test-dat))
(color (common:get-color-from-status status))
(logf (db:test-get-final_logf test-dat))
(steps-dat (tests:get-compressed-steps run-id test-id)))
;; (dcommon:get-compressed-steps #f 1 30045)
;; (#("wasting_time" "23:36:13" "23:36:21" "0" "8.0s" "wasting_time.log"))
(s:output-new
oup
(s:html
(s:title "Summary for " full-name)
(s:body
(s:h2 "Summary for " full-name)
(s:table 'cellspacing "0" 'border "1"
(s:tr (s:td "run id") (s:td (db:test-get-run_id test-dat))
(s:td "test id") (s:td (db:test-get-id test-dat)))
(s:tr (s:td "testname") (s:td test-name)
(s:td "itempath") (s:td item-path))
(s:tr (s:td "state") (s:td (db:test-get-state test-dat))
(s:td "status") (s:td (s:a 'href logf (s:font 'color color status))))
(s:tr (s:td "TestDate") (s:td (seconds->work-week/day-time
(db:test-get-event_time test-dat)))
(s:td "Duration") (s:td (seconds->hr-min-sec (db:test-get-run_duration test-dat)))))
(s:h3 "Log files")
(s:table
'cellspacing "0" 'border "1"
(s:tr (s:td "Final log")(s:td (s:a 'href logf logf))))
(s:table
'cellspacing "0" 'border "1"
(s:tr (s:td "Step Name")(s:td "Start")(s:td "End")(s:td "Status")(s:td "Duration")(s:td "Log File"))
(map (lambda (step-dat)
(s:tr (s:td (tdb:steps-table-get-stepname step-dat))
(s:td (tdb:steps-table-get-start step-dat))
(s:td (tdb:steps-table-get-end step-dat))
(s:td (tdb:steps-table-get-status step-dat))
(s:td (tdb:steps-table-get-runtime step-dat))
(s:td (let ((step-log (tdb:steps-table-get-log-file step-dat)))
(s:a 'href step-log step-log)))))
steps-dat))
)))
(close-output-port oup)))))
)
|