Megatest

Check-in [c76d156ddf]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Cherrypick of c7d908, c79779, ccab6
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.65-newbuild
Files: files | file ages | folders
SHA1: c76d156ddfa36c9396e2eb5d3a349eeb5a3464bc
User & Date: mrwellan on 2020-05-27 16:22:16
Other Links: branch diff | manifest | tags
Context
2020-05-27
16:22
Cherrypick of c7d908, c79779, ccab6 Closed-Leaf check-in: c76d156ddf user: mrwellan tags: v1.65-newbuild
16:18
Cherrypicked eeb358 check-in: ccb3a67d61 user: mrwellan tags: v1.65-newbuild
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [e8873ade8c] to [1053b6dcad].

︙
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43

29
30
31
32
33
34
35

36
37
38
39
40
41
42
43








-
+








           sdb.scm rmt.scm api.scm subrun.scm portlogger.scm		\
           archive.scm env.scm diff-report.scm				\
           cgisetup/models/pgdb.scm

# module source files
# ftail.scm rmtmod.scm commonmod.scm removed
MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
            mtargs.scm commonmod.scm
            mtargs.scm commonmod.scm dbmod.scm

GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\
          dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm	\
          vg.scm

OFILES   = $(SRCFILES:%.scm=%.o)
GOFILES  = $(GUISRCF:%.scm=%.o)
︙
77
78
79
80
81
82
83
84
85


86
87
88
89
90
91
92

77
78
79
80
81
82
83


84
85
86
87
88
89
90
91
92








-
-
+
+









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

showmtesthash:
	@echo $(MTESTHASH)

dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES)
	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) -o dboard
dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES)
	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard

ndboard : newdashboard.scm $(OFILES) $(GOFILES)
	csc $(CSCOPTS) $(OFILES) $(GOFILES) newdashboard.scm -o ndboard

mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm
	csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut
︙
201
202
203
204
205
206
207



208
209
210
211
212
213
214

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217








+
+
+








	csc $(CSCOPTS) -c $<

# specific rules for .o files that genuninely depend on mofiles/something
#
megatest.o : megatest.scm stml2.o mutils.o commonmod.o
	csc $(CSCOPTS) -c megatest.scm stml2.o mutils.o commonmod.o

dashboard.o : dashboard.scm stml2.o mutils.o commonmod.o dbmod.o
	csc $(CSCOPTS) -c megatest.scm stml2.o mutils.o commonmod.o dbmod.o

common.o : megatest.scm mofiles/commonmod.o common.scm
	csc $(CSCOPTS) -c common.scm mofiles/commonmod.o

configf.o : configf.scm mofiles/commonmod.o
	csc $(CSCOPTS) -c configf.scm mofiles/commonmod.o

$(PREFIX)/bin/.$(ARCHSTR)/mtest : mtest utils/mk_wrapper
︙

Modified TODO from [d6857e4403] to [23e18762ef].

︙
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

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








-






+
+
+
+
+
+








+








-








====

WW14
. Streamline compilation - DONE, all non-official egg modules are now bundled.

WW15
. syscheck; touch file in home, tmp, runs, links and start xterm
. pull in ftfplan (not integrated, just code pulled in)
. fill newview matrix with data, filter pipeline gui elements
. improve [script], especially indent handling

WW16
. split db into megatest.db (runs etc.) db/<something>.db
. release basic newview implementation
. archiving improvements/extentions
.. -get-data, -put-data
.. use MT_ vars if defined and no switch present
.. fix archive "first run" bug
.. areas path1 path2 ... -> search path for archives
.. -propagate -> move archive data forward when it is found in older bundles

WW18
. release split db implementation
. mtutil calls from dashboard (for remote control)
. logs browser (esp. for surfacing mtutil related activities)

WW19
. break command line into sections; all, run control, queries, utilities etc.
. pull in ftfplan (not integrated, just code pulled in)

WW20
. Switch to using simple runs query everywhere
. Add end_time to runs and add a rollup call that sets state, status and end_time

Future
. Switch to scsh-process pipeline management for job execution/control
. Use call-with-environment-variables more.


Migration to inmem db plus per run db
-------------------------------------

. Re-work the dbstruct data structure?
.. Move main.db to global?
.. [ run-id.db inmemdb last-mod last-read last-sync inuse ]
︙

Modified common.scm from [ab4de5a0a9] to [17bee313ac].

︙
1611
1612
1613
1614
1615
1616
1617
1618
1619

1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633

1634
1635
1636
1637
1638
1639
1640
1641
1642
1643

1611
1612
1613
1614
1615
1616
1617


1618
1619
1620
1621
1622
1623









1624



1625
1626
1627
1628
1629
1630
1631








-
-
+





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








		    (if (> curr-rownum rownum) curr-rownum rownum)
		    (if (> curr-colnum colnum) curr-colnum colnum)
		    ))))))

;; if it looks like a number -> convert it to a number, else return it
;;
(define (common:lazy-convert inval)
  (let* ((as-num (if (string? inval)(string->number inval) #f)))
    (or as-num inval)))
  (cmod:lazy-convert inval))

;; convert string a=1; b=2; c=a silly thing; d=
;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
;;
(define (common:val->alist val #!key (convert #f))
  (let ((val-list (string-split-fields ";\\s*" val #:infix)))
    (if val-list
	(map (lambda (x)
	       (let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
		 (case (length f)
		   ((0) `(,#f))  ;; null string case
		   ((1) `(,(string->symbol (car f))))
		   ((2) `(,(string->symbol (car f)) . ,(let ((inval (cadr f)))
							 (if convert (common:lazy-convert inval) inval))))
  (cmod:val->alist val #!key (convert #f)))
		   (else f))))
	     val-list)
	'())))

;;======================================================================
;; S Y S T E M   S T U F F
;;======================================================================

;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
;;
︙

Modified commonmod.scm from [f09504d905] to [3a4a140a66].

︙
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
68
69

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
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
96
97
98
99
100
101
102
103
104
105
106
107
108


109
110
111
112
113
114

115
116
117

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151








-
+
+

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













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








-
-
+
+
+
+
+

-
+


-
+



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








(declare (unit commonmod))

(module commonmod
	*
	
(import scheme chicken data-structures extras files)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69
	md5 message-digest)
	md5 message-digest
	regex srfi-1)

;;======================================================================
;; CONTENTS
;;
;;  config file utils
;;  misc conversion, data manipulation functions
(define (just-testing)
  (print "JUST TESTING"))
;;  testsuite and area utilites
;;
;;======================================================================

;;======================================================================
;; config file utils
;;======================================================================

(define (lookup cfgdat section var)
  (if (hash-table? cfgdat)
      (let ((sectdat (hash-table-ref/default cfgdat section '())))
	(if (null? sectdat)
	    #f
	    (let ((match (assoc var sectdat)))
	      (if match ;; (and match (list? match)(> (length match) 1))
		  (cadr match)
		  #f))
	    ))
      #f))

;; returns var key1=val1; key2=val2 ... as alist
(define (get-key-list cfgdat section var)
  ;; convert string a=1; b=2; c=a silly thing; d=
  (let ((valstr (lookup cfgdat section var)))
    (if valstr
	(val->alist valstr)
	'()))) ;; should it return empty list or #f to indicate not set?


(define (get-section cfgdat section)
  (hash-table-ref/default cfgdat section '()))

;;======================================================================
;; misc conversion, data manipulation functions
;;======================================================================

;; if it looks like a number -> convert it to a number, else return it
;;
(define (lazy-convert inval)
  (let* ((as-num (if (string? inval)(string->number inval) #f)))
    (or as-num inval)))

;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
;;
(define (val->alist val #!key (convert #f))
  (let ((val-list (string-split-fields ";\\s*" val #:infix)))
    (if val-list
	(map (lambda (x)
	       (let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
		 (case (length f)
		   ((0) `(,#f))  ;; null string case
		   ((1) `(,(string->symbol (car f))))
		   ((2) `(,(string->symbol (car f)) .
			  ,(let ((inval (cadr f)))
			     (if convert (lazy-convert inval) inval))))
		   (else f))))
	     (filter (lambda (x)
		       (not (string-match "^\\s*" x)))
		     val-list))
	'())))

;;======================================================================
;; testsuite and area utilites
;;======================================================================

(define (get-testsuite-name toppath configdat)
  (or (lookup configdat "setup" "area-name")
      (lookup configdat "setup" "testsuite")
      (get-environment-variable "MT_TESTSUITE_NAME")
      (if (string? toppath)
          (pathname-file toppath)
          #f)))

(define (get-area-path-signature toppath)
  (message-digest-string (md5-primitive) toppath))
(define (get-area-path-signature toppath #!optional (short #f))
  (let ((res (message-digest-string (md5-primitive) toppath)))
    (if short
	(substring res 0 4)
	res)))

(define (get-area-name toppath configdat)
(define (get-area-name configdat toppath #!optional (short #f))
  ;; look up my area name in areas table (future)
  ;; generate auto name
  (conc (get-area-path-signature toppath)
  (conc (get-area-path-signature toppath short)
	"-"
	(get-testsuite-name toppath configdat)))

;; need generic find-record-with-var-nmatching-val
;;
(define (path->area-record cfgdat path)
  (let* ((areadat (get-cfg-areas cfgdat))
	 (all     (filter (lambda (x)
			    (let* ((keyvals (cdr x))
				   (pth     (alist-ref 'path keyvals)))
			      (equal? path pth)))
			  areadat)))
    (if (null? all)
	#f
	(car all)))) ;; return first match

;; given a config return an alist of alists
;;   area-name => data
;;
(define (get-cfg-areas cfgdat)
  (let ((adat (get-section cfgdat "areas")))
    (map (lambda (entry)
	   `(,(car entry) . 
	     ,(val->alist (cadr entry))))
	 adat)))
	 
;; (define (debug:print . params) #f)
;; (define (debug:print-info . params) #f)
;; 
;; (define (set-functions dbgp dbgpinfo)
;;   (set! debug:print dbgp)
;;   (set! debug:print-info dbgpinfo))
︙

Modified dashboard.scm from [0930c846ee] to [647f8d5ef7].

︙
45
46
47
48
49
50
51





52
53
54
55
56
57
58

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63








+
+
+
+
+








(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
;; (declare (uses dashboard-main))
(declare (uses megatest-version))
(declare (uses mt))

(declare (uses dbmod))
(import (prefix dbmod dbmod:))
(declare (uses commonmod))
(import (prefix commonmod cmod:))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")
︙

Modified dbmod.scm from [d04b9ec825] to [2029a02dc3].

︙
14
15
16
17
18
19
20
21

22
23

24
25
26
27
28
29
30

14
15
16
17
18
19
20

21
22

23
24
25
26
27
28
29
30








-
+

-
+








;;     GNU General Public License for more details.
;; 
;;     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 commonmod))
(declare (unit dbmod))

(module commonmod
(module dbmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)

(define (just-testing)
  (print "JUST TESTING"))
︙

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