Megatest

Check-in [7277f625b0]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Ripped out gutils to find toplevel issue. I think I found the issue (dashboard-context-menu did not have import gutils), commiting then reverting gutils
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-nanomsg
Files: files | file ages | folders
SHA1: 7277f625b06b2ce64197bbbc7b2026710887ac62
User & Date: matt on 2021-11-08 18:52:42
Other Links: branch diff | manifest | tags
Context
2021-11-08
19:10
dashboard now compiles check-in: 10dfb310f4 user: matt tags: v1.6584-nanomsg
18:52
Ripped out gutils to find toplevel issue. I think I found the issue (dashboard-context-menu did not have import gutils), commiting then reverting gutils check-in: 7277f625b0 user: matt tags: v1.6584-nanomsg
2021-11-07
21:04
wip check-in: f2738dd699 user: matt tags: v1.6584-nanomsg
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [3ae4537ea3] to [a57a89892c].

︙
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

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








-
+


-
+





-
+


-
+








            debugprint.scm mtver.scm csv-xml.scm servermod.scm		\
            hostinfo.scm adjutant.scm processmod.scm testsmod.scm	\
            itemsmod.scm keysmod.scm mtmod.scm rmtmod.scm		\
            tasksmod.scm pgdb.scm launchmod.scm runsmod.scm		\
            portloggermod.scm archivemod.scm ezstepsmod.scm		\
            subrunmod.scm bigmod.scm testsmod.scm

GUISRCF = 
# GUISRCF = 

GUIMODFILES = tree.scm dashboard-tests.scm  vgmod.scm \
              dashboard-context-menu.scm dcommon.scm gutils.scm
              dashboard-context-menu.scm dcommon.scm 

# dashboard-guimonitor.scm 

mofiles/dashboard-context-menu.o : mofiles/dcommon.o
mofiles/dashboard-tests.o : mofiles/dcommon.o
mofiles/dcommon.o mofiles/tree.o : mofiles/gutils.o
# mofiles/dcommon.o mofiles/tree.o : mofiles/gutils.o

OFILES   = $(SRCFILES:%.scm=%.o)
GOFILES  = $(GUISRCF:%.scm=%.o)
# GOFILES  = $(GUISRCF:%.scm=%.o)

MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
GMOFILES = $(addprefix mofiles/,$(GUIMODFILES:%.scm=%.o))

# compiled import files
MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
GMOIMPFILES = $(GUIMODFILES:%.scm=%.import.o)
︙
132
133
134
135
136
137
138
139
140


141
142
143
144
145
146
147

132
133
134
135
136
137
138


139
140
141
142
143
144
145
146
147








-
-
+
+









mtest: megatest.scm $(MOFILES) $(MOIMPFILES)
	csc $(CSCOPTS) $(MOFILES) $(MOIMPFILES) megatest.scm -o mtest

showmtesthash:
	@echo $(MTESTHASH)

dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) $(GMOFILES) $(GMOIMPFILES) megatest-fossil-hash.scm
	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) $(GMOFILES) $(GMOIMPFILES) -o dboard
dboard : $(OFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) $(GMOFILES) $(GMOIMPFILES) megatest-fossil-hash.scm
	csc $(CSCOPTS) $(OFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) $(GMOFILES) $(GMOIMPFILES) -o dboard

mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm
	csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut

# include makefile.inc

TCMTOBJS = \
︙
420
421
422
423
424
425
426
427
428


429
430
431
432
433
434
435

420
421
422
423
424
425
426


427
428
429
430
431
432
433
434
435








-
-
+
+








	if  csi -ne '(import mysql-client)';then \
           echo "(import mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \
	fi
	if csi -ne '(import postgresql)';then \
	   echo "(import postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\
	fi

portlogger-example : portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o 
	csc $(CSCOPTS) portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o 
portlogger-example : portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o 
	csc $(CSCOPTS) portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o filedb.o genexample.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o 

buildmanual:
	cd docs/manual && make

targets:
	@grep : Makefile | perl -ne '/^([A-Za-z0-9_-]+):/ && print "$$1\n"'
︙

Modified dashboard-context-menu.scm from [8caa43c5f0] to [a09c15b6be].

︙
18
19
20
21
22
23
24














25
26
27
28
29
30
31

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








+
+
+
+
+
+
+
+
+
+
+
+
+
+









;;======================================================================

;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================

(declare (unit dashboard-context-menu))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dbmod))
;; (declare (uses gutils))
(declare (uses rmtmod))
(declare (uses ezstepsmod))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrunmod))
(declare (uses debugprint))
(declare (uses testsmod))
(declare (uses dcommon))

(module dashboard-context-menu
	*

(import format fmt)
(import (prefix iup iup:))
︙
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

57
58
59
60
61
62
63














64
65
66
67
68
69
70








-
-
-
-
-
-
-
-
-
-
-
-
-
-








	chicken.string
	chicken.time

	srfi-1
	regex regex-case srfi-69
	(prefix sqlite3 sqlite3:))

(declare (unit dashboard-context-menu))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dbmod))
(declare (uses gutils))
(declare (uses rmtmod))
(declare (uses ezstepsmod))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrunmod))
(declare (uses debugprint))
(declare (uses testsmod))
(declare (uses dcommon))

(import commonmod
	dbmod
	rmtmod
	ezstepsmod
	subrunmod
	debugprint
	configfmod
︙

Modified dashboard-tests.scm from [88eb1109dc] to [a9fbdc4290].

︙
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35

21
22
23
24
25
26
27

28
29
30
31
32
33
34
35








-
+








;;======================================================================
;; Test info panel
;;======================================================================

(declare (unit dashboard-tests))
(declare (uses commonmod))
(declare (uses dbmod))
(declare (uses gutils))
;; (declare (uses gutils))
(declare (uses rmtmod))
(declare (uses ezstepsmod))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrunmod))
(declare (uses debugprint))
(declare (uses configfmod))
︙
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80

66
67
68
69
70
71
72

73
74
75
76
77
78
79
80








-
+








(import commonmod
	dcommon
	dbmod
	rmtmod
	ezstepsmod
	subrunmod
	debugprint
	gutils
;;	gutils
	configfmod
	testsmod
	mtmod
	launchmod
	)

;;======================================================================
︙

Modified dashboard.scm from [4098d75325] to [8f64b2b555].

︙
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

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 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 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 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 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

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
	gutils
	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

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 (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))))

(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))
︙

Modified dcommon.scm from [f9d2919c2b] to [dedc418b9b].

︙
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29

15
16
17
18
19
20
21

22
23
24
25
26
27
28
29








-
+








;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (unit dcommon))
(declare (uses gutils))
;; (declare (uses gutils))
(declare (uses dbmod))
(declare (uses mtver))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses rmtmod))
(declare (uses mtargs))
︙
64
65
66
67
68
69
70
71

72
73
74
75
76
77
78

64
65
66
67
68
69
70

71
72
73
74
75
76
77
78








-
+









(import mtver
	dbmod
	commonmod
	debugprint
	configfmod
	rmtmod
	gutils
	;; gutils
	(prefix mtargs args:)
	testsmod)

;; (include "megatest-version.scm")
(include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
︙
1709
1710
1711
1712
1713
1714
1715
1716



1717
























































































1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719

1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806









+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

  (and (< lx1 px)(> lx2 px)))

(define (dashboard:recalc modtime please-update-buttons last-db-update-time)
  (or please-update-buttons
      (and ;; (> (current-milliseconds)(+ *last-recalc-ended-time* 150)) ;; can't use this - it needs to be tab specific
	   (> modtime (- last-db-update-time 3)) ;; add three seconds of margin
	   (> (current-seconds)(+ last-db-update-time 1)))))

;;======================================================================
;; stuff from gutils
;;
)

(define (iuplistbox-fill-list lb items #!key (selected-item #f))
  (let ((i 1))
    (for-each (lambda (item)
		(iup:attribute-set! lb (number->string i) item)
		(if selected-item
		    (if (equal? selected-item item)
			(iup:attribute-set! lb "VALUE" i))) ;; (number->string i))))
		(set! i (+ i 1)))
	      items)
    ;; (iup:attribute-set! lb "VALUE" (if selected-item selected-item ""))
    i))

(define (message-window msg)
  (iup:show
   (iup:dialog
    (iup:vbox 
     (iup:label msg #:margin "40x40")))))

;; NOTE: These functions will move to iuputils

(define (gutils: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))))

(define gutils:colors
  '((PASS . "70 249 73")
    (FAIL . "253 33 49")
    (SKIP . "230 230 0")))

(define (gutils:get-color-spec effective-state)
  (or (alist-ref effective-state gutils:colors)
      (alist-ref 'FAIL gutils:colors)))

;; BBnote - state status dashboard button color / text defined here
(define (gutils:get-color-for-state-status state status);; #!key (get-label #f))
  ;; ((if get-label cadr car)
  (case (string->symbol state)
    ((COMPLETED) ;; ARCHIVED)
     (case (string->symbol status)
       ((PASS)        (list "70  249 73" status))
       ((PREQ_FAIL PREQ_DISCARDED) (list "255 127 127" status))
       ((WARN WAIVED) (list "255 172 13" status))
       ((SKIP)        (list (gutils:get-color-spec 'SKIP) status))
       ((ABORT)       (list "198 36 166" status))
       (else (list "253 33 49" status))))
    ((ARCHIVED)
     (case (string->symbol status)
       ((PASS)        (list "70  170 73" status))
       ((WARN WAIVED) (list "200 130 13" status))
       ((SKIP)        (list (gutils:get-color-spec 'SKIP) status))
       (else (list "180 33 49" status))))
    ;;      (if (equal? status "PASS")
    ;;	  '("70 249 73" "PASS")
    ;;	  (if (or (equal? status "WARN")
    ;;		  (equal? status "WAIVED"))
    ;;	      (list "255 172 13" status)
    ;;	      (list "223 33 49"  status)))) ;; greenish orangeish redish
    ((LAUNCHED)         (list "101 123 142"  state))
    ((CHECK)            (list "255 100 50"   state))
    ((REMOTEHOSTSTART)  (list "50 130 195"   state))
    ((RUNNING STARTED)          (list "9 131 232"    state))
    ((KILLREQ)          (list "39 82 206"    state))
    ((KILLED)           (list "234 101 17"   state))
    ((NOT_STARTED)      (case (string->symbol status)
			  ((CHECK STARTED)(list (gutils:get-color-spec 'SKIP) state))
			  (else   (list "240 240 240"                 state))))
    ;; for xor mode below
    ;;
    ((CLEAN)
     (case (string->symbol status)
       ((CLEAN-FAIL CLEAN-CHECK CLEAN-ABORT)  (list "200 130 13" status)) ;; orange requested for these
       (else  (list "60  235 63" status))))
    ((DIRTY-BETTER)     (list "160  255 153" status))
    ((DIRTY-WORSE)      (list "165 42  42" status))
    ((BOTH-BAD)         (list "180 33 49" status))

    (else               (list
			 ;; "192 192 192"
			 "222 222 221"
			 state))))

;; end of stuff from gutils

)

Modified gutils.scm from [3b20c6cd4b] to [5bbbe79f17].

︙
17
18
19
20
21
22
23
24
25







26
27
28
29
30
31
32

17
18
19
20
21
22
23


24
25
26
27
28
29
30
31
32
33
34
35
36
37








-
-
+
+
+
+
+
+
+








;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (unit gutils))

(module gutils
	*
	
	(iuplistbox-fill-list
	 message-window
	 gutils:colors-similar?
	 gutils:colors
	 gutils:get-color-for-state-status
	 )
	 
(import (prefix iup iup:)
	canvas-draw)

(import scheme
	 chicken.base
	 chicken.condition
	 chicken.string
︙

Modified tree.scm from [e71588529d] to [8f57125d73].

︙
15
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
52
53
54






55
56
57
58
59


60
61
62
63
64
65
66

15
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
52
53
54
55
56
57
58


59
60
61
62
63
64
65
66
67








-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+



















-
-
-
-
-
+
+
+
+
+
+



-
-
+
+








;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (unit tree))
(declare (uses mtargs))
(declare (uses mtver))
(declare (uses launchmod))
;; (declare (uses megatest-version))
(declare (uses gutils))
(declare (uses dbmod))
(declare (uses servermod))
;; (declare (uses synchash))
(declare (uses dcommon))
;; (declare (uses mtargs))
;; (declare (uses mtver))
;; (declare (uses launchmod))
;; ;; (declare (uses megatest-version))
;; ;; (declare (uses gutils))
;; (declare (uses dbmod))
;; (declare (uses servermod))
;; ;; (declare (uses synchash))
;; (declare (uses dcommon))

(module tree
	*
	
(import scheme
	chicken.base
	chicken.string
	chicken.file.posix
	)

(import format
	srfi-13
	(prefix iup iup:)
	canvas-draw
	sqlite3
	srfi-1
	regex regex-case srfi-69
	(prefix sqlite3 sqlite3:))

(import mtver
	launchmod
	dbmod
	servermod
	gutils)
;; (import mtver
;; 	launchmod
;; 	dbmod
;; 	servermod
;; 	gutils
;; 	)

;; (include "megatest-version.scm")
;; (include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")

;;======================================================================
;; T R E E   S T U F F 
;;======================================================================

;; path is a list of nodes, each the child of the previous
;; this routine returns the id so another node can be added
︙

This page was generated in about 0.142s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00