Megatest

Check-in [b7a6ca20cb]
Login
Overview
Comment:Migrated db:mintest-get -> dbr:mintest
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | re-refactor-vec2defstruct
Files: files | file ages | folders
SHA1: b7a6ca20cbd376e002d822c6d6500b958b46af3b
User & Date: mrwellan on 2016-01-29 17:04:08
Other Links: branch diff | manifest | tags
Context
2016-09-09
00:00
Merged v1.61 into re-refactor-dbr:dbstruct branch. Can use meld to bring some of the work to v1.62 Closed-Leaf check-in: fb4085dbbf user: matt tags: re-refactor-vec2defstruct
2016-01-29
17:04
Migrated db:mintest-get -> dbr:mintest check-in: b7a6ca20cb user: mrwellan tags: re-refactor-vec2defstruct
15:17
converted db:test -> dbr:test check-in: ad54a64cae user: mrwellan tags: re-refactor-vec2defstruct
Changes

Modified db-test.sh from [d5cabb47a3] to [0d81b19014].

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
36
37
38











# perl -pi -e 's/db:test-set-testname!/db:test-testname-set!/g' *.scm
# perl -pi -e 's/db:test-set-status!/db:test-status-set!/g' *.scm
# perl -pi -e 's/db:test-set-state!/db:test-state-set!/g' *.scm
# perl -pi -e 's/db:test-set-run_duration!/db:test-run_duration-set!/g' *.scm
# perl -pi -e 's/db:test-set-final_logf!/db:test-final_logf-set!/g' *.scm
# perl -pi -e 's/db:test-set-diskfree!/db:test-diskfree-set!/g' *.scm
# perl -pi -e 's/db:test-set-cpuload!/db:test-cpuload-set!/g' *.scm

# fix few special cases
perl -pi -e 's/db:test-get-rundir-from-test-id/dbx:test-get-rundir-from-test-id/g' *scm
perl -pi -e 's/db:test-get-is-toplevel/dbx:test-is-toplevel/g' *.scm

perl -pi -e 's/db:test-uname/dbr:test-uname/g' *.scm
perl -pi -e 's/db:test-testname/dbr:test-testname/g' *.scm
perl -pi -e 's/db:test-status/dbr:test-status/g' *.scm
perl -pi -e 's/db:test-state/dbr:test-state/g' *.scm
perl -pi -e 's/db:test-rundir/dbr:test-rundir/g' *.scm
perl -pi -e 's/db:test-run_id/dbr:test-run_id/g' *.scm
perl -pi -e 's/db:test-run_duration/dbr:test-run_duration/g' *.scm
perl -pi -e 's/db:test-process_id/dbr:test-process_id/g' *.scm
perl -pi -e 's/db:test-pass_count/dbr:test-pass_count/g' *.scm
perl -pi -e 's/db:test-item-path/dbr:test-item-path/g' *.scm
perl -pi -e 's/db:test-id/dbr:test-id/g' *.scm
perl -pi -e 's/db:test-host/dbr:test-host/g' *.scm
perl -pi -e 's/db:test-fullname/dbr:test-fullname/g' *.scm
perl -pi -e 's/db:test-first_warn/dbr:test-first_warn/g' *.scm
perl -pi -e 's/db:test-first_err/dbr:test-first_err/g' *.scm
perl -pi -e 's/db:test-final_logf/dbr:test-final_logf/g' *.scm
perl -pi -e 's/db:test-fail_count/dbr:test-fail_count/g' *.scm
perl -pi -e 's/db:test-event_time/dbr:test-event_time/g' *.scm
perl -pi -e 's/db:test-diskfree/dbr:test-diskfree/g' *.scm
perl -pi -e 's/db:test-cpuload/dbr:test-cpuload/g' *.scm
perl -pi -e 's/db:test-comment/dbr:test-comment/g' *.scm
perl -pi -e 's/db:test-archived/dbr:test-archived/g' *.scm

perl -pi -e 's/dbx:test-get-rundir-from-test-id/db:test-get-rundir-from-test-id/g' *scm
perl -pi -e 's/dbx:test-is-toplevel/db:test-is-toplevel/g' *.scm





















|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
# perl -pi -e 's/db:test-set-testname!/db:test-testname-set!/g' *.scm
# perl -pi -e 's/db:test-set-status!/db:test-status-set!/g' *.scm
# perl -pi -e 's/db:test-set-state!/db:test-state-set!/g' *.scm
# perl -pi -e 's/db:test-set-run_duration!/db:test-run_duration-set!/g' *.scm
# perl -pi -e 's/db:test-set-final_logf!/db:test-final_logf-set!/g' *.scm
# perl -pi -e 's/db:test-set-diskfree!/db:test-diskfree-set!/g' *.scm
# perl -pi -e 's/db:test-set-cpuload!/db:test-cpuload-set!/g' *.scm

# fix few special cases
# perl -pi -e 's/db:test-get-rundir-from-test-id/dbx:test-get-rundir-from-test-id/g' *scm
# perl -pi -e 's/db:test-get-is-toplevel/dbx:test-is-toplevel/g' *.scm
# 
# perl -pi -e 's/db:test-uname/dbr:test-uname/g' *.scm
# perl -pi -e 's/db:test-testname/dbr:test-testname/g' *.scm
# perl -pi -e 's/db:test-status/dbr:test-status/g' *.scm
# perl -pi -e 's/db:test-state/dbr:test-state/g' *.scm
# perl -pi -e 's/db:test-rundir/dbr:test-rundir/g' *.scm
# perl -pi -e 's/db:test-run_id/dbr:test-run_id/g' *.scm
# perl -pi -e 's/db:test-run_duration/dbr:test-run_duration/g' *.scm
# perl -pi -e 's/db:test-process_id/dbr:test-process_id/g' *.scm
# perl -pi -e 's/db:test-pass_count/dbr:test-pass_count/g' *.scm
# perl -pi -e 's/db:test-item-path/dbr:test-item-path/g' *.scm
# perl -pi -e 's/db:test-id/dbr:test-id/g' *.scm
# perl -pi -e 's/db:test-host/dbr:test-host/g' *.scm
# perl -pi -e 's/db:test-fullname/dbr:test-fullname/g' *.scm
# perl -pi -e 's/db:test-first_warn/dbr:test-first_warn/g' *.scm
# perl -pi -e 's/db:test-first_err/dbr:test-first_err/g' *.scm
# perl -pi -e 's/db:test-final_logf/dbr:test-final_logf/g' *.scm
# perl -pi -e 's/db:test-fail_count/dbr:test-fail_count/g' *.scm
# perl -pi -e 's/db:test-event_time/dbr:test-event_time/g' *.scm
# perl -pi -e 's/db:test-diskfree/dbr:test-diskfree/g' *.scm
# perl -pi -e 's/db:test-cpuload/dbr:test-cpuload/g' *.scm
# perl -pi -e 's/db:test-comment/dbr:test-comment/g' *.scm
# perl -pi -e 's/db:test-archived/dbr:test-archived/g' *.scm
# 
# perl -pi -e 's/dbx:test-get-rundir-from-test-id/db:test-get-rundir-from-test-id/g' *scm
# perl -pi -e 's/dbx:test-is-toplevel/db:test-is-toplevel/g' *.scm
# 

# bash-3.00$ egrep 'db:mintest-(get|set)' db_records.scm|perl -pi -e 's/.*db:mintest-(\S*)(\s+.*|)$/perl -pi -e "s\/db:mintest-$1\/dbr:mintest-$1\/g *.scm"/'|sort -ur

bash-3.00$ egrep 'db:mintest-(get|set)' db_records.scm|perl -pi -e 's/.*db:mintest-(\S*)(\s+.*|)$/perl -pi -e "s\/db:mintest-$1\/dbr:mintest-$1\/g" *.scm/'|sort -ur
perl -pi -e "s/db:mintest-get-testname/dbr:mintest-get-testname/g" *.scm
perl -pi -e "s/db:mintest-get-status/dbr:mintest-get-status/g" *.scm
perl -pi -e "s/db:mintest-get-state/dbr:mintest-get-state/g" *.scm
perl -pi -e "s/db:mintest-get-run_id/dbr:mintest-get-run_id/g" *.scm
perl -pi -e "s/db:mintest-get-item_path/dbr:mintest-get-item_path/g" *.scm
perl -pi -e "s/db:mintest-get-id/dbr:mintest-get-id/g" *.scm
perl -pi -e "s/db:mintest-get-event_time/dbr:mintest-get-event_time/g" *.scm

Modified db_records.scm from [6ebfa70275] to [b1470dce48].

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
(define (db:test-is-toplevel vec)
  (and (equal? (dbr:test-item-path vec) "")      ;; test is not an item
       (equal? (dbr:test-uname vec)     "n/a"))) ;; test has never been run

;; make-vector-record "" db mintest id run_id testname state status event_time item_path
;;
(define (make-db:mintest)(make-vector 7))
(define-inline (db:mintest-get-id           vec)    (vector-ref  vec 0))
(define-inline (db:mintest-get-run_id       vec)    (vector-ref  vec 1))
(define-inline (db:mintest-get-testname     vec)    (vector-ref  vec 2))
(define-inline (db:mintest-get-state        vec)    (vector-ref  vec 3))
(define-inline (db:mintest-get-status       vec)    (vector-ref  vec 4))
(define-inline (db:mintest-get-event_time   vec)    (vector-ref  vec 5))
(define-inline (db:mintest-get-item_path    vec)    (vector-ref  vec 6))

;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk
(define (make-db:testmeta)(make-vector 10 ""))
(define-inline (db:testmeta-get-id            vec)    (vector-ref  vec 0))
(define-inline (db:testmeta-get-testname      vec)    (vector-ref  vec 1))
(define-inline (db:testmeta-get-author        vec)    (vector-ref  vec 2))
(define-inline (db:testmeta-get-owner         vec)    (vector-ref  vec 3))







|
|
|
|
|
|
|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
(define (db:test-is-toplevel vec)
  (and (equal? (dbr:test-item-path vec) "")      ;; test is not an item
       (equal? (dbr:test-uname vec)     "n/a"))) ;; test has never been run

;; make-vector-record "" db mintest id run_id testname state status event_time item_path
;;
(define (make-db:mintest)(make-vector 7))
(define-inline (dbr:mintest-id           vec)    (vector-ref  vec 0))
(define-inline (dbr:mintest-run_id       vec)    (vector-ref  vec 1))
(define-inline (dbr:mintest-testname     vec)    (vector-ref  vec 2))
(define-inline (dbr:mintest-state        vec)    (vector-ref  vec 3))
(define-inline (dbr:mintest-status       vec)    (vector-ref  vec 4))
(define-inline (dbr:mintest-event_time   vec)    (vector-ref  vec 5))
(define-inline (dbr:mintest-item_path    vec)    (vector-ref  vec 6))

;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk
(define (make-db:testmeta)(make-vector 10 ""))
(define-inline (db:testmeta-get-id            vec)    (vector-ref  vec 0))
(define-inline (db:testmeta-get-testname      vec)    (vector-ref  vec 1))
(define-inline (db:testmeta-get-author        vec)    (vector-ref  vec 2))
(define-inline (db:testmeta-get-owner         vec)    (vector-ref  vec 3))

Modified dcommon.scm from [88282b727e] to [7deac09b14].

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
238
239
240
241
242
243
244
245
246
247
248
249
    ;; Do this analysis in the order of the run-ids, the most recent run wins
    (for-each (lambda (run-id)
		(let* ((run-path       (hash-table-ref (dboard:data-get-run-keys *data*) run-id))
		       (test-changes   (hash-table-ref all-test-changes run-id))
		       (new-test-dat   (car test-changes))
		       (removed-tests  (cadr test-changes))
		       (tests          (sort (map cadr (filter (lambda (testrec)
								 (eq? run-id (db:mintest-get-run_id (cadr testrec))))
							       new-test-dat))
					     (lambda (a b)
					       (let ((time-a (db:mintest-get-event_time a))
						     (time-b (db:mintest-get-event_time b)))
						 (> time-a time-b)))))
		       ;; test-changes is a list of (( id record ) ... )
		       ;; Get list of test names sorted by time, remove tests
		       (test-names (delete-duplicates (map (lambda (t)
							     (let ((i (db:mintest-get-item_path t))
								   (n (db:mintest-get-testname  t)))
							       (if (string=? i "")
								   (conc "   " i)
								   n)))
							   tests)))
		       (colnum     (car (hash-table-ref runid-to-col run-id))))
		  ;; for each test name get the slot if it exists and fill in the cell
		  ;; or take the next slot and fill in the cell, deal with items in the
		  ;; run view panel? The run view panel can have a tree selector for
		  ;; browsing the tests/items

		  ;; SWITCH THIS TO USING CHANGED TESTS ONLY
		  (for-each (lambda (test)
			      (let* ((test-id   (db:mintest-get-id test))
				     (state     (db:mintest-get-state test))
				     (status    (db:mintest-get-status test))
				     (testname  (db:mintest-get-testname test))
				     (itempath  (db:mintest-get-item_path test))
				     (fullname  (conc testname "/" itempath))
				     (dispname  (if (string=? itempath "") testname (conc "   " itempath)))
				     (rownum    (hash-table-ref/default testname-to-row fullname #f))
				     (test-path (append run-path (if (equal? itempath "") 
								     (list testname)
								     (list testname itempath))))
				     (tb         (dboard:data-get-tests-tree *data*)))







|


|
|




|
|












|
|
|
|
|







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
238
239
240
241
242
243
244
245
246
247
248
249
    ;; Do this analysis in the order of the run-ids, the most recent run wins
    (for-each (lambda (run-id)
		(let* ((run-path       (hash-table-ref (dboard:data-get-run-keys *data*) run-id))
		       (test-changes   (hash-table-ref all-test-changes run-id))
		       (new-test-dat   (car test-changes))
		       (removed-tests  (cadr test-changes))
		       (tests          (sort (map cadr (filter (lambda (testrec)
								 (eq? run-id (dbr:mintest-run_id (cadr testrec))))
							       new-test-dat))
					     (lambda (a b)
					       (let ((time-a (dbr:mintest-event_time a))
						     (time-b (dbr:mintest-event_time b)))
						 (> time-a time-b)))))
		       ;; test-changes is a list of (( id record ) ... )
		       ;; Get list of test names sorted by time, remove tests
		       (test-names (delete-duplicates (map (lambda (t)
							     (let ((i (dbr:mintest-item_path t))
								   (n (dbr:mintest-testname  t)))
							       (if (string=? i "")
								   (conc "   " i)
								   n)))
							   tests)))
		       (colnum     (car (hash-table-ref runid-to-col run-id))))
		  ;; for each test name get the slot if it exists and fill in the cell
		  ;; or take the next slot and fill in the cell, deal with items in the
		  ;; run view panel? The run view panel can have a tree selector for
		  ;; browsing the tests/items

		  ;; SWITCH THIS TO USING CHANGED TESTS ONLY
		  (for-each (lambda (test)
			      (let* ((test-id   (dbr:mintest-id test))
				     (state     (dbr:mintest-state test))
				     (status    (dbr:mintest-status test))
				     (testname  (dbr:mintest-testname test))
				     (itempath  (dbr:mintest-item_path test))
				     (fullname  (conc testname "/" itempath))
				     (dispname  (if (string=? itempath "") testname (conc "   " itempath)))
				     (rownum    (hash-table-ref/default testname-to-row fullname #f))
				     (test-path (append run-path (if (equal? itempath "") 
								     (list testname)
								     (list testname itempath))))
				     (tb         (dboard:data-get-tests-tree *data*)))

Modified runs.scm from [c09835a467] to [b521780e15].

1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449

		  ((and skip-check
			(configf:lookup test-conf "skip" "rundelay"))
		   ;; run-ids = #f means *all* runs
		   (let* ((numseconds      (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay")))
			  (running-tests   (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f))
			  (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex
			  (last-run-times  (map db:mintest-get-event_time completed-tests))
			  (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (apply max last-run-times)))))
		     (if (or (not (null? running-tests)) ;; have to skip if test is running
			     (> numseconds time-since-last))
			 (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago"))))))
		 
		 (if skip-test
		     (begin







|







1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449

		  ((and skip-check
			(configf:lookup test-conf "skip" "rundelay"))
		   ;; run-ids = #f means *all* runs
		   (let* ((numseconds      (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay")))
			  (running-tests   (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f))
			  (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex
			  (last-run-times  (map dbr:mintest-event_time completed-tests))
			  (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (apply max last-run-times)))))
		     (if (or (not (null? running-tests)) ;; have to skip if test is running
			     (> numseconds time-since-last))
			 (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago"))))))
		 
		 (if skip-test
		     (begin