16
17
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
|
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(declare (uses ducttape-lib))
(declare (uses bigmod))
(declare (uses bigmod.import))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dashboard-context-menu))
(declare (uses dashboard-tests))
(declare (uses dbmod))
(declare (uses dcommon))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses gutils))
(declare (uses itemsmod))
(declare (uses launchmod))
(declare (uses mtargs))
(declare (uses mtmod))
(declare (uses mtver))
(declare (uses processmod))
(declare (uses runsmod))
(declare (uses subrunmod))
(declare (uses tree))
(declare (uses vgmod))
;; (declare (uses dashboard-guimonitor))
;; (declare (uses dashboard-main))
(import (prefix iup iup:))
(import canvas-draw)
;; (import canvas-draw-iup)
|
|
>
|
|
|
|
|
|
|
|
|
<
|
|
|
|
|
|
|
|
|
|
>
|
16
17
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
|
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(declare (uses ducttape-lib))
;; (declare (uses bigmod))
;; (declare (uses gutils))
;; (declare (uses bigmod.import))
;; (declare (uses commonmod))
;; (declare (uses configfmod))
;; (declare (uses dashboard-context-menu))
;; (declare (uses dashboard-tests))
;; (declare (uses dbmod))
;; (declare (uses dcommon))
;; (declare (uses debugprint))
;; (declare (uses debugprint.import))
;; (declare (uses itemsmod))
;; (declare (uses launchmod))
;; (declare (uses mtargs))
;; (declare (uses mtmod))
;; (declare (uses mtver))
;; (declare (uses processmod))
;; (declare (uses runsmod))
;; (declare (uses subrunmod))
;; (declare (uses tree))
;; (declare (uses vgmod))
;; (declare (uses dashboard-guimonitor))
;; (declare (uses dashboard-main))
(import (prefix iup iup:))
(import canvas-draw)
;; (import canvas-draw-iup)
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
;; (include "run_records.scm")
;; (include "task_records.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
;; (include "vg_records.scm")
(import commonmod
configfmod
dbmod
debugprint
itemsmod
launchmod
(prefix mtargs args:)
mtmod
mtver
processmod
runsmod
subrunmod
vgmod
dcommon
gutils
|
>
<
|
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
;; (include "run_records.scm")
;; (include "task_records.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
;; (include "vg_records.scm")
(import commonmod
;; gutils
configfmod
dbmod
debugprint
itemsmod
launchmod
(prefix mtargs args:)
mtmod
mtver
processmod
runsmod
subrunmod
vgmod
dcommon
tree
dashboard-context-menu
dashboard-tests)
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
|
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
|
(define-inline (dboard:uidat-get-header vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))
(if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME")))
(define (pad-list l n)(append l (make-list (- n (length l)))))
(define (colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
(delta (map (lambda (a b)(abs (- a b))) c1 c2)))
(null? (filter (lambda (x)(> x 3)) delta))))
|
<
<
<
<
<
<
|
540
541
542
543
544
545
546
547
548
549
550
551
552
553
|
(define-inline (dboard:uidat-get-header vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))
(if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME")))
(define (pad-list l n)(append l (make-list (- n (length l)))))
(define (dboard:compare-tests test1 test2)
(let* ((test-name1 (db:test-get-testname test1))
(item-path1 (db:test-get-item-path test1))
(eventtime1 (db:test-get-event_time test1))
(test-name2 (db:test-get-testname test2))
(item-path2 (db:test-get-item-path test2))
(eventtime2 (db:test-get-event_time test2))
|