Megatest

Check-in [3cbc9cb854]
Login
Overview
Comment:Progress on monitor based running
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 3cbc9cb854fe298dda8320edf5e9f0d62d792fe8
User & Date: matt on 2011-10-23 06:02:53
Other Links: manifest | tags
Context
2011-10-23
16:42
Blindly duplicated run logic to use in monitor based launching check-in: f97980cf8c user: matt tags: trunk
06:02
Progress on monitor based running check-in: 3cbc9cb854 user: matt tags: trunk
2011-10-22
00:22
Initial (and completely untested) framework for monitor based running check-in: 5be1cf4b7c user: matt tags: trunk
Changes

Modified Makefile from [2418e6dec9] to [d16e947139].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34

PREFIX=.

SRCFILES = common.scm items.scm launch.scm \
           ods.scm runconfig.scm server.scm configf.scm \
           db.scm keys.scm margs.scm megatest-version.scm \
           process.scm runs.scm

GUISRCF  = dashboard.scm dashboard-tests.scm

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

HELPERS=$(addprefix $(PREFIX)/bin/,mt_laststep mt_runstep mt_ezstep)

all : megatest dboard

megatest: $(OFILES) megatest.o
	csc $(OFILES) megatest.o -o megatest

dboard : $(OFILES) $(GOFILES)
	csc $(OFILES) $(GOFILES) -o dboard

# Special dependencies for the includes
db.o launch.o runs.o dashboard-tests.o dashboard.o megatest.o : db_records.scm
runs.o dashboard.o dashboard-tests.o   : run_records.scm
keys.o db.o runs.o launch.o megatest.o : key_records.scm


$(OFILES) $(GOFILES) : common_records.scm 

%.o : %.scm
	csc -c $<

$(PREFIX)/bin/megatest : megatest






|

|


















>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

PREFIX=.

SRCFILES = common.scm items.scm launch.scm \
           ods.scm runconfig.scm server.scm configf.scm \
           db.scm keys.scm margs.scm megatest-version.scm \
           process.scm runs.scm tasks.scm

GUISRCF  = dashboard.scm dashboard-tests.scm dashboard-guimonitor.scm

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

HELPERS=$(addprefix $(PREFIX)/bin/,mt_laststep mt_runstep mt_ezstep)

all : megatest dboard

megatest: $(OFILES) megatest.o
	csc $(OFILES) megatest.o -o megatest

dboard : $(OFILES) $(GOFILES)
	csc $(OFILES) $(GOFILES) -o dboard

# Special dependencies for the includes
db.o launch.o runs.o dashboard-tests.o dashboard.o megatest.o : db_records.scm
runs.o dashboard.o dashboard-tests.o   : run_records.scm
keys.o db.o runs.o launch.o megatest.o : key_records.scm
tasks.o dashboard-tasks.o : task_records.scm

$(OFILES) $(GOFILES) : common_records.scm 

%.o : %.scm
	csc -c $<

$(PREFIX)/bin/megatest : megatest

Modified dashboard-tests.scm from [5d11432313] to [f1756cabc9].

109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
	    (store-meta "reviewed" 
			 (iup:label (db:testmeta-get-reviewed testmeta) #:expand "HORIZONTAL")
			 (lambda (testmeta)(db:testmeta-get-reviewed testmeta)))
	    (store-meta "tags" 
			 (iup:label (db:testmeta-get-tags testmeta) #:expand "HORIZONTAL")
			 (lambda (testmeta)(db:testmeta-get-tags testmeta)))
	    (store-meta "description" 
			 (iup:label (db:testmeta-get-description testmeta) #:expand "HORIZONTAL")
			 (lambda (testmeta)(db:testmeta-get-description testmeta)))
	    )))))


;;======================================================================
;; Run info panel
;;======================================================================







|







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
	    (store-meta "reviewed" 
			 (iup:label (db:testmeta-get-reviewed testmeta) #:expand "HORIZONTAL")
			 (lambda (testmeta)(db:testmeta-get-reviewed testmeta)))
	    (store-meta "tags" 
			 (iup:label (db:testmeta-get-tags testmeta) #:expand "HORIZONTAL")
			 (lambda (testmeta)(db:testmeta-get-tags testmeta)))
	    (store-meta "description" 
			 (iup:label (db:testmeta-get-description testmeta) #:size "x50"); #:expand "HORIZONTAL")
			 (lambda (testmeta)(db:testmeta-get-description testmeta)))
	    )))))


;;======================================================================
;; Run info panel
;;======================================================================
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
     #:title "Set fields"
     (iup:vbox
      (iup:hbox (iup:label "Comment:")
		(iup:textbox #:action (lambda (val a b)
					(db:test-set-state-status-by-id *db* test-id #f #f b)
					(set! newcomment b))
			     #:value (db:test-get-comment testdat)
			     #:expand "YES"))
      (apply iup:hbox
	     (iup:label "STATE:" #:size "30x")
	     (let* ((btns  (map (lambda (state)
				  (let ((btn (iup:button state
							 #:expand "YES" #:size "50x" #:font "Courier New, -10"
							 #:action (lambda (x)
								    (db:test-set-state-status-by-id *db* test-id state #f #f)
								    (db:test-set-state! testdat state)))))
				    btn))
				(list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "KILLED" "KILLREQ"))))
	       (vector-set! *state-status* 0
			    (lambda (state color)
			      (for-each 
			       (lambda (btn)
				 (let* ((name     (iup:attribute btn "TITLE"))
					(newcolor (if (equal? name state) color "192 192 192")))
				   (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
				       (iup:attribute-set! btn "BGCOLOR" newcolor))))
			       btns)))
	       btns))
      (apply iup:hbox
	     (iup:label "STATUS:" #:size "30x")
	     (let* ((btns  (map (lambda (status)
				  (let ((btn (iup:button status
							 #:expand "YES" #:size "50x" #:font "Courier New, -10"
							 #:action (lambda (x)
								    (db:test-set-state-status-by-id *db* test-id #f status #f)
								    (db:test-set-status! testdat status)))))
				    btn))
				(list  "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED"))))
	       (vector-set! *state-status* 1
			    (lambda (status color)







|




|



















|







198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
     #:title "Set fields"
     (iup:vbox
      (iup:hbox (iup:label "Comment:")
		(iup:textbox #:action (lambda (val a b)
					(db:test-set-state-status-by-id *db* test-id #f #f b)
					(set! newcomment b))
			     #:value (db:test-get-comment testdat)
			     #:expand "HORIZONTAL"))
      (apply iup:hbox
	     (iup:label "STATE:" #:size "30x")
	     (let* ((btns  (map (lambda (state)
				  (let ((btn (iup:button state
							 #:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10"
							 #:action (lambda (x)
								    (db:test-set-state-status-by-id *db* test-id state #f #f)
								    (db:test-set-state! testdat state)))))
				    btn))
				(list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "KILLED" "KILLREQ"))))
	       (vector-set! *state-status* 0
			    (lambda (state color)
			      (for-each 
			       (lambda (btn)
				 (let* ((name     (iup:attribute btn "TITLE"))
					(newcolor (if (equal? name state) color "192 192 192")))
				   (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
				       (iup:attribute-set! btn "BGCOLOR" newcolor))))
			       btns)))
	       btns))
      (apply iup:hbox
	     (iup:label "STATUS:" #:size "30x")
	     (let* ((btns  (map (lambda (status)
				  (let ((btn (iup:button status
							 #:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10"
							 #:action (lambda (x)
								    (db:test-set-state-status-by-id *db* test-id #f status #f)
								    (db:test-set-status! testdat status)))))
				    btn))
				(list  "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED"))))
	       (vector-set! *state-status* 1
			    (lambda (status color)
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
						  (begin
						    ;(mutex-lock! mx1)
						    (iup:attribute-set! lbl "TITLE" newval)
						    ;(mutex-unlock! mx1)
						    )))))
			 lbl))
	 (store-button store-label)
	 (command-text-box (iup:textbox #:expand "YES" #:font "Courier New, -10"))
	 (command-launch-button (iup:button "Execute!" #:action (lambda (x)
								  (let ((cmd (iup:attribute command-text-box "VALUE")))
								    (system (conc cmd "  &"))))))
	 (run-test  (lambda (x)
		      (iup:attribute-set! 
		       command-text-box "VALUE"
		       (conc "megatest -runtests " testname " " keystring " :runname " runname 







|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
						  (begin
						    ;(mutex-lock! mx1)
						    (iup:attribute-set! lbl "TITLE" newval)
						    ;(mutex-unlock! mx1)
						    )))))
			 lbl))
	 (store-button store-label)
	 (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10"))
	 (command-launch-button (iup:button "Execute!" #:action (lambda (x)
								  (let ((cmd (iup:attribute command-text-box "VALUE")))
								    (system (conc cmd "  &"))))))
	 (run-test  (lambda (x)
		      (iup:attribute-set! 
		       command-text-box "VALUE"
		       (conc "megatest -runtests " testname " " keystring " :runname " runname 

Modified dashboard.scm from [8573d45a21] to [1bf80313b8].

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
(declare (uses items))
(declare (uses db))
(declare (uses configf))
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))

(declare (uses megatest-version))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

(define help (conc 
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright (C) Matt Welland 2011

Usage: dashboard [options]
  -h              : this help
  -run runid      : control run identified by runid
  -test testid    : control test identified by testid


Misc
  -rows N         : set number of rows
"))

;; process args
(define remargs (args:get-args 
		 (argv)
		 (list  "-rows"
			"-run"
			"-test"
			"-debug"
			) 
		 (list  "-h"

			"-v"
			"-q"
		       )
		 args:arg-hash
		 0))

(if (args:get-arg "-h")







>













<

>














>







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
(declare (uses items))
(declare (uses db))
(declare (uses configf))
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses dashboard-guimonitor))
(declare (uses megatest-version))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

(define help (conc 
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright (C) Matt Welland 2011

Usage: dashboard [options]
  -h              : this help

  -test testid    : control test identified by testid
  -guimonitor     : control panel for runs

Misc
  -rows N         : set number of rows
"))

;; process args
(define remargs (args:get-args 
		 (argv)
		 (list  "-rows"
			"-run"
			"-test"
			"-debug"
			) 
		 (list  "-h"
			"-guimonitor"
			"-v"
			"-q"
		       )
		 args:arg-hash
		 0))

(if (args:get-arg "-h")
457
458
459
460
461
462
463

464
465
466
467
468
469
470
				      (update-search "test-name" val)))
	      (iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
			   #:action (lambda (obj unk val)
				      (set! *last-db-update-time* 0)
				      (update-search "item-name" val)))))
	    (iup:hbox
	     (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))

	     ))
	   ;; (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
	   ;; (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
	   ;; (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))
	   ;; (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset*  (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))
	   (iup:frame 
	    #:title "hide"







>







459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
				      (update-search "test-name" val)))
	      (iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
			   #:action (lambda (obj unk val)
				      (set! *last-db-update-time* 0)
				      (update-search "item-name" val)))))
	    (iup:hbox
	     (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
	     (iup:button "Monitor" #:action (lambda (obj)(system (conc (car (argv))" -guimonitor &"))))
	     ))
	   ;; (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
	   ;; (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
	   ;; (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))
	   ;; (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset*  (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))
	   (iup:frame 
	    #:title "hide"
656
657
658
659
660
661
662


663
664
665
666
667
668
669
670
671
 ((args:get-arg "-test")
    (let ((testid (string->number (args:get-arg "-test"))))
    (if testid
	(examine-test *db* testid)
	(begin
	  (print "ERROR: testid is not a number " (args:get-arg "-test"))
	  (exit 1)))))


 (else
  (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*))
  (iup:callback-set! *tim*
		     "ACTION_CB"
		     (lambda (x)
		       (run-update x)))))
		       ;(print x)))))

(iup:main-loop)







>
>









659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
 ((args:get-arg "-test")
    (let ((testid (string->number (args:get-arg "-test"))))
    (if testid
	(examine-test *db* testid)
	(begin
	  (print "ERROR: testid is not a number " (args:get-arg "-test"))
	  (exit 1)))))
 ((args:get-arg "-guimonitor")
  (gui-monitor *db*))
 (else
  (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*))
  (iup:callback-set! *tim*
		     "ACTION_CB"
		     (lambda (x)
		       (run-update x)))))
		       ;(print x)))))

(iup:main-loop)

Modified db.scm from [2c08171fe3] to [7df6739618].

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
152
153
	                        value REAL,
	                        expected REAL,
	                        tol REAL,
                                units TEXT,
                                comment TEXT DEFAULT '',
                                status TEXT DEFAULT 'n/a',
                                type TEXT DEFAULT '',
                              CONSTRAINT test_data UNIQUE (test_id,category,variable));")
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS task_queue (id INTEGER PRIMARY KEY,
                                action TEXT DEFAULT '',
                                owner TEXT,
                                state TEXT DEFAULT 'new',
                                target TEXT DEFAULT '',
                                name TEXT DEFAULT '',
                                test TEXT DEFAULT '',
                                item TEXT DEFAULT '',
                                creation_time TIMESTAMP,
                                execution_time TIMESTAMP;")
	  (sqlite3:execute db "CREATE monitors (id INTEGER PRIMARY KEY,
                                pid INTEGER,
                                start_time TIMESTAMP,
                                last_update TIMESTAMP,
                                hostname TEXT,
                                username TEXT);")

	  ;; Must do this *after* running patch db !! No more. 
	  (db:set-var db "MEGATEST_VERSION" megatest-version)
	  ))
    db))

;;======================================================================
;; TODO:







|










|




|
>







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
152
153
154
	                        value REAL,
	                        expected REAL,
	                        tol REAL,
                                units TEXT,
                                comment TEXT DEFAULT '',
                                status TEXT DEFAULT 'n/a',
                                type TEXT DEFAULT '',
                              CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));")
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS task_queue (id INTEGER PRIMARY KEY,
                                action TEXT DEFAULT '',
                                owner TEXT,
                                state TEXT DEFAULT 'new',
                                target TEXT DEFAULT '',
                                name TEXT DEFAULT '',
                                test TEXT DEFAULT '',
                                item TEXT DEFAULT '',
                                creation_time TIMESTAMP,
                                execution_time TIMESTAMP;")
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY,
                                pid INTEGER,
                                start_time TIMESTAMP,
                                last_update TIMESTAMP,
                                hostname TEXT,
                                username TEXT,
                               CONSTRAINT monitors_constraint UNIQUE (pid,hostname));")
	  ;; Must do this *after* running patch db !! No more. 
	  (db:set-var db "MEGATEST_VERSION" megatest-version)
	  ))
    db))

;;======================================================================
;; TODO:
216
217
218
219
220
221
222
223
224
225
226

















227
228
229
230
231
232
233
                                status TEXT DEFAULT 'n/a',foss
                              CONSTRAINT test_data UNIQUE (test_id,category,variable));")
       (patch-db))
      ((< mver 1.27)
       (db:set-var db "MEGATEST_VERSION" 1.27)
       (sqlite3:execute db "ALTER TABLE test_data ADD COLUMN type TEXT DEFAULT '';")
       (patch-db))
      ((< mver 1.28)
       (db:set-var db "MEGATEST_VERSION" 1.28)
       (sqlite3:execute db "ALTER TABLE test_steps ADD COLUMN logfile TEXT;")
       (sqlite3:execute db "ALTER TABLE tests ADD COLUMN shortdir TEXT DEFAULT '';")

















       (patch-db))
      ((< mver megatest-version)
       (db:set-var db "MEGATEST_VERSION" megatest-version))))))

;;======================================================================
;; meta get and set vars
;;======================================================================







|
|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
                                status TEXT DEFAULT 'n/a',foss
                              CONSTRAINT test_data UNIQUE (test_id,category,variable));")
       (patch-db))
      ((< mver 1.27)
       (db:set-var db "MEGATEST_VERSION" 1.27)
       (sqlite3:execute db "ALTER TABLE test_data ADD COLUMN type TEXT DEFAULT '';")
       (patch-db))
      ((< mver 1.29)
       (db:set-var db "MEGATEST_VERSION" 1.29)
       (sqlite3:execute db "ALTER TABLE test_steps ADD COLUMN logfile TEXT;")
       (sqlite3:execute db "ALTER TABLE tests ADD COLUMN shortdir TEXT DEFAULT '';")
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tasks_queue (id INTEGER PRIMARY KEY,
                                action TEXT DEFAULT '',
                                owner TEXT,
                                state TEXT DEFAULT 'new',
                                target TEXT DEFAULT '',
                                name TEXT DEFAULT '',
                                test TEXT DEFAULT '',
                                item TEXT DEFAULT '',
                                creation_time TIMESTAMP,
                                execution_time TIMESTAMP);")
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY,
                                pid INTEGER,
                                start_time TIMESTAMP,
                                last_update TIMESTAMP,
                                hostname TEXT,
                                username TEXT,
                               CONSTRAINT monitors_constraint UNIQUE (pid,hostname));")
       (patch-db))
      ((< mver megatest-version)
       (db:set-var db "MEGATEST_VERSION" megatest-version))))))

;;======================================================================
;; meta get and set vars
;;======================================================================

Modified megatest-version.scm from [d71a892788] to [77298102e9].

1
2
3
4
5
6
7
;; Always use two digit decimal
;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.28)






|

1
2
3
4
5
6
7
;; Always use two digit decimal
;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.29)

Modified megatest.scm from [d64eb95b04] to [510b81566b].

84
85
86
87
88
89
90
91
92



93
94
95
96
97
98
99
100
101
102
103
104
105
  -keepgoing              : continue running until no jobs are \"LAUNCHED\" or
                            \"NOT_STARTED\"
  -rerun FAIL,WARN...     : re-run if called on a test that previously ran (nullified
                            if -keepgoing is also specified)
  -rebuild-db             : bring the database schema up to date
  -rollup                 : fill run (set by :runname)  with latest test(s) from
                            prior runs with same keys
  -rename-run <runb>      : rename run (set by :runname) to <runb>, requires keys
  -update-meta            : update the tests metadata for all tests



  -extract-ods            : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style
  -env2file fname         : write the environment to fname.csh and fname.sh

Helpers
  -runstep stepname  ...  : take remaining params as comand and execute as stepname
                            log will be in stepname.log. Best to put command in quotes
  -logpro file            : with -exec apply logpro file to stepname.log, creates
                            stepname.html and sets log to same
                            If using make use stepname_logpro.log as your target







<

>
>
>





<







84
85
86
87
88
89
90

91
92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
  -keepgoing              : continue running until no jobs are \"LAUNCHED\" or
                            \"NOT_STARTED\"
  -rerun FAIL,WARN...     : re-run if called on a test that previously ran (nullified
                            if -keepgoing is also specified)
  -rebuild-db             : bring the database schema up to date
  -rollup                 : fill run (set by :runname)  with latest test(s) from
                            prior runs with same keys

  -update-meta            : update the tests metadata for all tests
  -env2file fname         : write the environment to fname.csh and fname.sh

Spreadsheet generation
  -extract-ods            : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style


Helpers
  -runstep stepname  ...  : take remaining params as comand and execute as stepname
                            log will be in stepname.log. Best to put command in quotes
  -logpro file            : with -exec apply logpro file to stepname.log, creates
                            stepname.html and sets log to same
                            If using make use stepname_logpro.log as your target

Modified task_records.scm from [80557f0cbb] to [185f9a1436].

19
20
21
22
23
24
25
26
27

28
29
30
31
32
(define-inline (tasks:task-get-name             vec)    (vector-ref  vec 5))
(define-inline (tasks:task-get-test             vec)    (vector-ref  vec 6))
(define-inline (tasks:task-get-item             vec)    (vector-ref  vec 7))
(define-inline (tasks:task-get-creation_time    vec)    (vector-ref  vec 8))
(define-inline (tasks:task-get-execution_time   vec)    (vector-ref  vec 9))


;; make-vector-record tasks monitor pid start_time last_update hostname username
(define (make-tasks:monitor)(make-vector 5))

(define-inline (tasks:monitor-get-pid           vec)    (vector-ref  vec 0))
(define-inline (tasks:monitor-get-start_time    vec)    (vector-ref  vec 1))
(define-inline (tasks:monitor-get-last_update   vec)    (vector-ref  vec 2))
(define-inline (tasks:monitor-get-hostname      vec)    (vector-ref  vec 3))
(define-inline (tasks:monitor-get-username      vec)    (vector-ref  vec 4))







|

>
|
|
|
|
|
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
(define-inline (tasks:task-get-name             vec)    (vector-ref  vec 5))
(define-inline (tasks:task-get-test             vec)    (vector-ref  vec 6))
(define-inline (tasks:task-get-item             vec)    (vector-ref  vec 7))
(define-inline (tasks:task-get-creation_time    vec)    (vector-ref  vec 8))
(define-inline (tasks:task-get-execution_time   vec)    (vector-ref  vec 9))


;; make-vector-record tasks monitor id pid start_time last_update hostname username
(define (make-tasks:monitor)(make-vector 5))
(define-inline (tasks:monitor-get-id            vec)    (vector-ref  vec 0))
(define-inline (tasks:monitor-get-pid           vec)    (vector-ref  vec 1))
(define-inline (tasks:monitor-get-start_time    vec)    (vector-ref  vec 2))
(define-inline (tasks:monitor-get-last_update   vec)    (vector-ref  vec 3))
(define-inline (tasks:monitor-get-hostname      vec)    (vector-ref  vec 4))
(define-inline (tasks:monitor-get-username      vec)    (vector-ref  vec 5))

Modified tasks.scm from [3678acac04] to [1354231a43].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
;; Copyright 2006-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking)
(import (prefix sqlite3 sqlite3:))

(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")

;;======================================================================
;; Tasks and Task monitors
;;======================================================================













|


|


<
<

<
<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17


18




19
20
21
22
23
24
25
;; Copyright 2006-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
(import (prefix sqlite3 sqlite3:))

(declare (unit tasks))
(declare (uses db))
(declare (uses common))







(include "task_records.scm")

;;======================================================================
;; Tasks and Task monitors
;;======================================================================


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


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

(define (tasks:register-monitor db)
  (let* ((pid (current-process-id))
	 (hostname (get-host-name))
	 (userinfo (user-information (current-user-id)))
	 (username (car userinfo)))

    (sqlite3:execute db "INSERT INTO monitors (pid,start_time,last_update,hostname,username) VALUES (?,strftime('%s','now'),strftime('%s','now'),?,?);"
		     pid hostname username)))

(define (tasks:get-num-alive-monitors db)
  (let ((res 0))
    (sqlite3:for-each-row 
     (lambda (count)
       (set! res count))
     db
     "SELECT count(id) FROM monitors WHERE last_update < (strftime('%s','now') - 300) AND username=?;"
     (car (user-information (current-user-id))))
    res))





























;; return one task from those who are 'new' OR 'waiting' AND more than 10sec old
;;
(define (tasks:snag-a-task db)
  (let ((res #f))
    (with-transaction 
     db
     (lambda ()

       (sqlite3:for-each-row
	(lambda (id . rem)
	  (set! res (apply vector id rem)))
	db
	"SELECT id,action,owner,state,target,name,test,item,creation_time,exectution_time 
           FROM tasks_queue
             WHERE 
                state='new' OR (state='waiting' AND 
                                last_update+10 > strftime('%s','now'))

             LIMIT 1;")
       (if res ;; yep, have work to be done
	   (begin
	     (sqlite3:execute db "UPDATE tasks_queue SET state='inprogress' WHERE id=?;"
			      (tasks:task-get-id res))




























	     res))))))

(define (tasks:start-monitor db)
  (if (> (tasks:get-num-alive-monitors db) 2) ;; have two running, no need for more
      (debug:print 1 "INFO: Not starting monitor, already have more than two running")
      (let* ((megatestdb     (conc *toppath* "/megatest.db"))
	     (last-db-update 0)) ;; (file-modification-time megatestdb)))
	(task:register-monitor db)
	(let loop ((count 0))

	  ;; if the db has been modified we'd best look at the task queue
	  (let ((modtime (file-modification-time megatestdb)))
	    (if (> modtime last-db-update)










		(let* ((task   (tasks:snag-a-task db))
		       (action (if task (tasks:task-get-action task) #f)))
		  (if action
		      (case (string->symbol action)
			((run)       (tasks:start-run   db task))
			((remove)    (tasks:remove-runs db task))
			((lock)      (tasks:lock-runs   db task))
			((monitor)   (tasks:start-monitor db task))
			((rollup)    (tasks:rollup-runs db task))
			((updatemeta)(tasks:update-meta db task))
			((kill)      (tasks:kill-monitors db task))))
		  ;; WARNING: Possible race conditon here!!
		  ;; should this update be immediately after the task-get-action call above?








		  (set! modtime (file-modification-time megatestdb)))))














	  (loop (+ count 1))))))






























		  
	




	









>













>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







>




|


|
|
>
|


|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







|
>

|

>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
|
>
>
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
;;======================================================================

(define (tasks:register-monitor db)
  (let* ((pid (current-process-id))
	 (hostname (get-host-name))
	 (userinfo (user-information (current-user-id)))
	 (username (car userinfo)))
    (print "Register monitor, pid: " pid ", hostname: " hostname ", username: " username)
    (sqlite3:execute db "INSERT INTO monitors (pid,start_time,last_update,hostname,username) VALUES (?,strftime('%s','now'),strftime('%s','now'),?,?);"
		     pid hostname username)))

(define (tasks:get-num-alive-monitors db)
  (let ((res 0))
    (sqlite3:for-each-row 
     (lambda (count)
       (set! res count))
     db
     "SELECT count(id) FROM monitors WHERE last_update < (strftime('%s','now') - 300) AND username=?;"
     (car (user-information (current-user-id))))
    res))

;; register a task
(define (tasks:add db action owner target runname test item)
  (sqlite3:execute db "INSERT INTO tasks_queue (action,owner,state,target,name,test,item,creation_time,execution_time)
                       VALUES (?,?,'new',?,?,?,?,strftime('%s','now'),0);" 
		   action
		   owner
		   target
		   runname
		   test
		   item))

(define (keys:key-vals-hash->target keys key-params)
  (let ((tmp (hash-table-ref/default key-params (vector-ref (car keys) 0) "")))
    (if (> (length keys) 1)
	(for-each (lambda (key)
		    (set! tmp (conc tmp "/" (hash-table-ref/default key-params (vector-ref key 0) ""))))
		  (cdr keys)))
    tmp))
								
;; for use from the gui
(define (tasks:add-from-params db action keys key-params var-params)
  (let ((target    (keys:key-vals-hash->target keys key-params))
	(owner     (car (user-information (current-user-id))))
	(runname   (hash-table-ref/default var-params "runname" #f))
	(testpatts (hash-table-ref/default var-params "testpatts" "%"))
	(itempatts (hash-table-ref/default var-params "itempatts" "%")))
    (tasks:add db action owner target runname testpatts itempatts)))

;; return one task from those who are 'new' OR 'waiting' AND more than 10sec old
;;
(define (tasks:snag-a-task db)
  (let ((res #f))
    (with-transaction 
     db
     (lambda ()
       ;; execution time is updated with every snag, wait 10 secs before doing anything with the queue
       (sqlite3:for-each-row
	(lambda (id . rem)
	  (set! res (apply vector id rem)))
	db
	"SELECT id,action,owner,state,target,name,test,item,creation_time,execution_time 
           FROM tasks_queue
             WHERE 
                state='new' OR
                (state='waiting' AND execution_time+10 > strftime('%s','now')) OR
                state='reset'
             ORDER BY state ASC LIMIT 1;")
       (if res ;; yep, have work to be done
	   (begin
	     (sqlite3:execute db "UPDATE tasks_queue SET state='inprogress',execution_time=strftime('%s','now') WHERE id=?;"
			      (tasks:task-get-id res))
	     res)
	   #f)))))

(define (tasks:reset-stuck-tasks db)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (id delta)
       (set! res (cons id res)))
     db
     "SELECT id,strftime('%s','now')-execution_time AS delta FROM tasks_queue WHERE state='inprogress' AND delta>700 ORDER BY delta DESC LIMIT 2;")
    (sqlite3:execute 
     db 
     (conc "UPDATE tasks_queue SET state='reset' WHERE id IN ('" (string-intersperse (map conc res) "','") "');"))))

;; return all tasks in the tasks_queue table
;;
(define (tasks:get-tasks db types states)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (id . rem)
       (set! res (cons (apply vector id rem) res)))
     db
     (conc "SELECT id,action,owner,state,target,name,test,item,creation_time,execution_time 
               FROM tasks_queue "
               ;; WHERE  
               ;;   state IN " statesstr " AND 
	       ;;   action IN " actionsstr 
	   " ORDER BY creation_time DESC;"))
    res))

(define (tasks:start-monitor db)
  (if (> (tasks:get-num-alive-monitors db) 2) ;; have two running, no need for more
      (debug:print 1 "INFO: Not starting monitor, already have more than two running")
      (let* ((megatestdb     (conc *toppath* "/megatest.db"))
	     (last-db-update 0)) ;; (file-modification-time megatestdb)))
	(task:register-monitor db)
	(let loop ((count      0)
		   (next-touch 0)) ;; next-touch is the time where we need to update last_update
	  ;; if the db has been modified we'd best look at the task queue
	  (let ((modtime (file-modification-time megatestdbpath )))
	    (if (> modtime last-db-update)
		(tasks:process-queue db last-db-update megatestdb next-touch))
	    ;; WARNING: Possible race conditon here!!
	    ;; should this update be immediately after the task-get-action call above?
	    (if (> (current-seconds) next-touch)
		(begin
		  (tasks:monitors-update db)
		  (loop (+ count 1)(+ (current-seconds) 240)))
		(loop (+ count 1) next-touch)))))))
      
(define (tasks:process-queue db megatestdbpath)
  (let* ((task   (tasks:snag-a-task db))
	 (action (if task (tasks:task-get-action task) #f)))
    (if action
	(case (string->symbol action)
	  ((run)       (tasks:start-run   db task))
	  ((remove)    (tasks:remove-runs db task))
	  ((lock)      (tasks:lock-runs   db task))
	  ;; ((monitor)   (tasks:start-monitor db task))
	  ((rollup)    (tasks:rollup-runs db task))
	  ((updatemeta)(tasks:update-meta db task))
	  ((kill)      (tasks:kill-monitors db task))))))

(define (tasks:get-monitors db)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (a . rem)
       (set! res (cons (apply vector a rem) res)))
     db
     "SELECT id,pid,strftime('%m/%d/%Y %H:%M',datetime(start_time,'unixepoch'),'localtime'),strftime('%m/%d/%Y %H:%M:%S',datetime(last_update,'unixepoch'),'localtime'),hostname,username FROM monitors ORDER BY last_update ASC;")
    (reverse res)
    ))

(define (tasks:tasks->text tasks)
  (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~12a"))
    (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "itempatts") "\n"
	  (string-intersperse 
	   (map (lambda (task)
		  (format #f fmtstr
			  (tasks:task-get-id     task)
			  (tasks:task-get-action task)
			  (tasks:task-get-owner  task)
			  (tasks:task-get-state  task)
			  (tasks:task-get-target task)
			  (tasks:task-get-name   task)
			  (tasks:task-get-test   task)
			  (tasks:task-get-item   task)))
		tasks) "\n"))))
   
(define (tasks:monitors->text-table monitors)
  (let ((fmtstr "~4a~8a~20a~20a~10a~10a"))
    (conc (format #f fmtstr "id" "pid" "start time" "last update" "hostname" "user") "\n"
	  (string-intersperse 
	   (map (lambda (monitor)
		  (format #f fmtstr
			  (tasks:monitor-get-id          monitor)
			  (tasks:monitor-get-pid         monitor)
			  (tasks:monitor-get-start_time  monitor)
			  (tasks:monitor-get-last_update monitor)
			  (tasks:monitor-get-hostname    monitor)
			  (tasks:monitor-get-username    monitor)))
		monitors)
	   "\n"))))
   
;; update the last_update field with the current time and
;; if any monitors appear dead, remove them
(define (tasks:monitors-update db)
  (sqlite3:execute db "UPDATE monitors SET last_update=strftime('%s','now') WHERE pid=? AND hostname=?;"
			  (current-process-id)
			  (get-host-name))
  (let ((deadlist '()))
    (sqlite3:for-each-row
     (lambda (id pid host last-update delta)
       (print "Going to delete stale record for monitor with pid " pid " on host " host " last updated " delta " seconds ago")
       (set! deadlist (cons id deadlist)))
     db 
     "SELECT id,pid,hostname,last_update,strftime('%s','now')-last_update AS delta FROM monitors WHERE delta > 700;")
    (sqlite3:execute db (conc "DELETE FROM monitors WHERE id IN ('" (string-intersperse (map conc deadlist) "','") "');")))
  )

(define (tasks:remove-monitor-record db)
  (sqlite3:execute db "DELETE FROM monitors WHERE pid=? AND hostname=?;"
		   (current-process-id)
		   (get-host-name)))

(define (tasks:start-run db task)
  (print "Starting run " task))

Modified tests/megatest.config from [dd77d506f9] to [6d5060d736].

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
22
[fields]
sysname TEXT
fsname TEXT
datapath TEXT

[setup]
# exectutable /path/to/megatest
# max_concurrent_jobs 4
runsdir /tmp/runs

[jobtools]

# ## launcher launches jobs, the job is managed on the target host
## by megatest, comment out launcher to run local
# workhosts localhost hermes
launcher nbfake
# launcher nodanggood

## use "xterm -e csi -- " as a launcher to examine the launch environment.
## exit with (exit)
## get a shell with (system "bash")
# launcher xterm -e csi --












>



|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
[fields]
sysname TEXT
fsname TEXT
datapath TEXT

[setup]
# exectutable /path/to/megatest
# max_concurrent_jobs 4
runsdir /tmp/runs

[jobtools]
useshell yes
# ## launcher launches jobs, the job is managed on the target host
## by megatest, comment out launcher to run local
# workhosts localhost hermes
# launcher nbfake
# launcher nodanggood

## use "xterm -e csi -- " as a launcher to examine the launch environment.
## exit with (exit)
## get a shell with (system "bash")
# launcher xterm -e csi --