Megatest

Changes On Branch bf70f7cd40203f44
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

Changes In Branch rollup Through [bf70f7cd40] Excluding Merge-Ins

This is equivalent to a diff from b82c04e7f3 to bf70f7cd40

2011-09-05
17:11
completed rollup and updated remove-runs to preserve test runs where there are still references in the db check-in: 94a65715c9 user: matt tags: trunk
16:22
Reworked remove runs to only delete directories no longer referenced in the database check-in: 2961a06589 user: matt tags: rollup (unpublished)
2011-09-04
20:12
Added rollup. check-in: bf70f7cd40 user: matt tags: rollup (unpublished)
2011-09-03
21:07
Merged accidental change of version in wrong branch to trunk check-in: b82c04e7f3 user: matt tags: trunk
2011-09-01
11:33
Bumped version to 1.22. Closed-Leaf check-in: a1198a099f user: mrwellan tags: v1.22, waiver-propagation
2011-08-30
22:59
Merged WAIVER propagation into trunk and bumped version check-in: 39d81114d3 user: matt tags: trunk

Modified common.scm from [ae869b679b] to [361ea4a752].

︙
49
50
51
52
53
54
55








56
57
58
59
60
61
62

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70








+
+
+
+
+
+
+
+








  (if (<= n *verbosity*)
      (apply print params)))

;; if a value is printable (i.e. string or number) return the value
;; else return an empty string
(define-inline (printable val)
  (if (or (number? val)(string? val)) val ""))

;; convert stuff to a number if possible
(define (any->number val)
  (cond 
   ((number? val) val)
   ((string? val) (string->number val))
   ((symbol? val) (any->number (symbol->string val)))
   (else #f)))

;;======================================================================
;; System stuff
;;======================================================================

(define (get-df path)
  (let* ((df-results (cmd-run->list (conc "df " path)))
︙

Modified dashboard-tests.scm from [87658c9114] to [5627038660].

︙
353
354
355
356
357
358
359
360

361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393

353
354
355
356
357
358
359

360


























361
362
363
364
365
366
367








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








		(let ((stepsdat (iup:label "Test steps ........................................." 
					   #:expand "YES" 
					   #:size "200x150"
					   #:alignment "ALEFT:ATOP")))
		  (hash-table-set! widgets "Test Steps" (lambda (testdat)
							  (let* ((currval (iup:attribute stepsdat "TITLE"))
								 (fmtstr  "~25a~10a~10a~15a~20a")
								 (steps   (db:get-steps-for-test db test-id))
								 (comprsteps (db:get-steps-table db test-id))
								 ;; organise the steps for better readability
								 (comprsteps (let ((res (make-hash-table)))
									       (for-each 
										(lambda (step)
										  (let ((record (hash-table-ref/default 
												 res 
												 (db:step-get-stepname step) 
												 ;;        stepname                 start end status
												 (vector (db:step-get-stepname step) "" "" "" ""))))
										    (case (string->symbol (db:step-get-state step))
										      ((start)(vector-set! record 1 (db:step-get-event_time step))
										              (vector-set! record 3 (if (equal? (vector-ref record 3) "")
															(db:step-get-status step))))
										      ((end)  (vector-set! record 2 (db:step-get-event_time step))
										              (vector-set! record 3 (db:step-get-status step))
											      (vector-set! record 4 (let ((startt (vector-ref record 1))
															  (endt   (vector-ref record 2)))
														      (if (and (number? startt)(number? endt))
															  (seconds->hr-min-sec (- endt startt)) "-1"))))
										      (else   (vector-set! record 1 (db:step-get-event_time step)))
											      (vector-set! record 2 (db:step-get-state step))
											      (vector-set! record 3 (db:step-get-status step))
											      (vector-set! record 4 (db:step-get-event_time step)))
										    (hash-table-set! res (db:step-get-stepname step) record)))
										steps)
									       res))
								 (newval  (string-intersperse 
									   (append
									    (list 
									     (format #f fmtstr "Stepname" "Start" "End"    "Status" "Time")
									     (format #f fmtstr "========" "=====" "======" "======" "=========="))
									    (map (lambda (x)
										   ;; take advantage of the \n on time->string
︙
417
418
419
420
421
422
423


391
392
393
394
395
396
397
398








+

			      ;; (print "Updating " key)
			      ((hash-table-ref widgets key) testdat))
			    (hash-table-keys widgets))
			   (update-state-status-buttons testdat)
					; (iup:refresh self)
			   (if *exit-started*
			       (set! *exit-started* 'ok))))))))

Modified db.scm from [fd4588d610] to [8d79c7b2db].

︙
473
474
475
476
477
478
479
480
481
482






483
484
485
486
487







488
489
490
491
492
493
























494
495
496
497










498
499
500
501
502
503
504

473
474
475
476
477
478
479



480
481
482
483
484
485





486
487
488
489
490
491
492






493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516




517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533








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








     (lambda (id test-id stepname state status event-time)
       (set! res (cons (vector id test-id stepname state status event-time) res)))
     db
     "SELECT id,test_id,stepname,state,status,event_time FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
     test-id)
    (reverse res)))

;; ;; check that *all* the prereqs are "COMPLETED"
;; (define (db-get-prereqs-met db run-id waiton)
;;   (let ((res          #f)
;; get a pretty table to summarize steps
;;
(define (db:get-steps-table db test-id)
  (let ((steps   (db:get-steps-for-test db test-id)))
    ;; organise the steps for better readability
    (let ((res (make-hash-table)))
;; 	(not-complete 0)
;; 	(tests        (db-get-tests-for-run db run-id)))
;;     (for-each
;;      (lambda (test-name)
;;        (for-each 
      (for-each 
       (lambda (step)
	 (debug:print 6 "step=" step)
	 (let ((record (hash-table-ref/default 
			res 
			(db:step-get-stepname step) 
			;;        stepname                start end status
;; 	(lambda (test)
;; 	  (if (equal? (db:test-get-testname test) test-name)
;; 	      (begin
;; 		(set! res #t)
;; 		(if (not (equal? (db:test-get-state test) "COMPLETED"))
;; 		    (set! not-complete (+ 1 not-complete))))))
			(vector (db:step-get-stepname step) ""   "" ""     ""))))
	   (debug:print 6 "record(before) = " record 
			"\nid:       " (db:step-get-id step)
			"\nstepname: " (db:step-get-stepname step)
			"\nstate:    " (db:step-get-state step)
			"\nstatus:   " (db:step-get-status step)
			"\ntime:     " (db:step-get-event_time step))
	   (case (string->symbol (db:step-get-state step))
	     ((start)(vector-set! record 1 (db:step-get-event_time step))
	      (vector-set! record 3 (if (equal? (vector-ref record 3) "")
					(db:step-get-status step))))
	     ((end)  
	      (vector-set! record 2 (any->number (db:step-get-event_time step)))
	      (vector-set! record 3 (db:step-get-status step))
	      (vector-set! record 4 (let ((startt (any->number (vector-ref record 1)))
					  (endt   (any->number (vector-ref record 2))))
				      (debug:print 4 "record[1]=" (vector-ref record 1) 
						   ", startt=" startt ", endt=" endt
						   ", get-status: " (db:step-get-status step))
				      (if (and (number? startt)(number? endt))
					  (seconds->hr-min-sec (- endt startt)) "-1"))))
	     (else   (vector-set! record 1 (db:step-get-event_time step)))
	     (vector-set! record 2 (db:step-get-state step))
	     (vector-set! record 3 (db:step-get-status step))
;; 	tests))
;;      waiton)
;;     (and (or (null? waiton) res)
;; 	 (eq? not-complete 0))))
	     (vector-set! record 4 (db:step-get-event_time step)))
	   (hash-table-set! res (db:step-get-stepname step) record)
	   (debug:print 6 "record(after)  = " record 
			"\nid:       " (db:step-get-id step)
			"\nstepname: " (db:step-get-stepname step)
			"\nstate:    " (db:step-get-state step)
			"\nstatus:   " (db:step-get-status step)
			"\ntime:     " (db:step-get-event_time step))))
       (sort steps (lambda (a b)(< (db:step-get-event_time a)(db:step-get-event_time b)))))
      res)))

;; USE: (lset-difference string=? '("a" "b" "c") '("d" "c" "e" "a"))
;;
;; Return a list of prereqs that were NOT met
;;  Tests (and all items) in waiton list must be "COMPLETED" and "PASS"
(define (db-get-prereqs-not-met db run-id waiton)
  (if (null? waiton)
︙

Modified megatest.scm from [1ec4b37821] to [6417d3c92b].

︙
61
62
63
64
65
66
67
68
69


70
71
72
73
74
75
76

61
62
63
64
65
66
67


68
69
70
71
72
73
74
75
76








-
-
+
+








                            and :runname ,-testpatt and -itempatt
                            and -testpatt
  -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 N               : fill run (set by :runname)  with latest test(s) from
                            past N days, requires keys
  -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

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
︙
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315

301
302
303
304
305
306
307

308
309
310
311
312
313
314
315








-
+








;;======================================================================
(if (args:get-arg "-rollup")
    (general-run-call 
     "-rollup" 
     "rollup tests" 
     (lambda (db keys keynames keyvallst)
       (let ((n (args:get-arg "-rollup")))
	 (runs:rollup db keys keynames keyvallst n)))))
	 (runs:rollup-run db keys)))))

;;======================================================================
;; run one test
;;======================================================================

;; 1. find the config file
;; 2. change to the test directory
︙

Modified runs.scm from [40302d30cf] to [f3e89435b8].

︙
118
119
120
121
122
123
124

































125
126
127
128
129
130
131

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








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








		(let ((results (db-get-tests-for-run db hed test-name item-path)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      (car results)))))))))
    
;; get the previous record for when this test was run where all keys match but runname
;; NB// Merge this with test:get-previous-test-run-records
(define (test:get-matching-previous-test-run-records db run-id test-name item-path)
  (let* ((keys    (db:get-keys db))
	 (selstr  (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
	 (keyvals #f))
    ;; first look up the key values from the run selected by run-id
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))
     db
     (conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;") run-id)
    (if (not keyvals)
	#f
	(let ((prev-run-ids '()))
	  (apply sqlite3:for-each-row
		 (lambda (id)
		   (set! prev-run-ids (cons id prev-run-ids)))
		 db
		 (conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id)))
	  ;; for each run starting with the most recent look to see if there is a matching test
	  ;; if found then return that matching test record
	  (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals ", previous run ids found: " prev-run-ids)
	  (if (null? prev-run-ids) #f
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db-get-tests-for-run db hed test-name item-path)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      results))))))))

(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
  (let* ((real-status status)
	 (item-path   (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
	 (otherdat    (if dat dat (make-hash-table)))
	 ;; before proceeding we must find out if the previous test (where all keys matched except runname)
	 ;; was WAIVED if this test is FAIL
︙
792
793
794
795
796
797
798

799

800







801
802








803
804
805
806
































825
826
827
828
829
830
831
832

833
834
835
836
837
838
839
840
841


842
843
844
845
846
847
848
849
850



851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881








+
-
+

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

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

	      (test-configf (conc test-path "/testconfig"))
	      (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	      ;; read configs with tricks turned off (i.e. no system)
	      (test-conf    (if testexists (read-config test-configf #f #f)(make-hash-table))))
	 (runs:update-test_meta db test-name test-conf)))
     test-names)))
	 
;; This could probably be refactored into one complex query ...
(define (runs:rollup-run db keys keynames keyvallst n)
(define (runs:rollup-run db keys)
  (let* ((new-run-id   (register-run db keys))
	 (prev-tests   (test:get-matching-previous-test-run-records db new-run-id "%" "%"))
	 (curr-tests   (db-get-tests-for-run db new-run-id "%" "%"))
	 (curr-tests-hash (make-hash-table)))
    ;; index the already saved tests by testname and itempath in curr-tests-hash
    (for-each
     (lambda (testdat)
       (let* ((testname  (db:test-get-testname testdat))
	 (similar-runs (db:get-runs db keys))
	 (tests-n-days (db:get-tests-n-days db similar-runs)))
	      (item-path (db:test-get-item-path testdat))
	      (full-name (conc testname "/" item-path)))
	 (hash-table-set! curr-tests-hash full-name testdat)))
     curr-tests)
    ;; now for each test record found, if it is more recent than that which is stored in
    ;; the db then:
    ;;   1. update the db with all data from the newer record
    ;;   2. update the lookup table
    (for-each 
     (lambda (test-id)
       (db:rollup-test db run-id test-id))
     tests-n-days)))
     (lambda (testdat)
       (let* ((testname  (db:test-get-testname testdat))
	      (item-path (db:test-get-item-path testdat))
	      (full-name (conc testname "/" item-path))
	      (prev-test-dat (hash-table-ref/default curr-tests-hash full-name #f)))
	 ;; if testdat is more recent than prev-test-dat or if there is no prev-test-dat
	 ;; then update the database and the hash table with this new record
	 (if (or (not prev-test-dat)
		 (> (db:test-get-event_time testdat)
		    (db:test-get-event_time prev-test-dat)))
	     (let ((test-steps      (db:get-steps-for-test db (db:test-get-id testdat)))
		   (new-test-record #f))
	       ;; replace these with insert ... select
	       (apply sqlite3:execute 
		db 
		(conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,value,expected_value,tol,units,first_err,first_warn) "
		      "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);")
		new-run-id (cddr (vector->list testdat)))
	       (set! new-testdat (car (db-get-tests-for-run db new-run-id testname item-path)))
	       (hash-table-set! curr-tests-hash full-name new-testdat) ;; this could be confusing, which record should go into the lookup table?
	       ;; Now duplicate the test steps
	       (debug:print 4 "Copying records in test_steps from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
	       (sqlite3:execute 
		db 
		(conc "INSERT OR REPLACE INTO test_steps (test_id,stepname,state,status,event_time,comment) "
		      "SELECT " (db:test-get-id new-testdat) ",stepname,state,status,event_time,comment FROM test_steps WHERE test_id=?;")
		(db:test-get-id testdat))
	       ))))
     prev-tests)))

Modified tests/tests.scm from [197f496658] to [d03a123d61]. 

1
2
3

4
5
6
7
8
9
10
11

12


13
14
15
16
17
18
19

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




+








+

+
+








(use test)
;; (require-library args)

(include "../megatest.scm")
(include "../common.scm")
(include "../keys.scm")
(include "../db.scm")
(include "../configf.scm")
(include "../process.scm")
(include "../launch.scm")
(include "../items.scm")
(include "../runs.scm")
(include "../runconfig.scm")
(include "../megatest-version.scm")

(define test-work-dir (current-directory))

(define conffile #f)
(test "Read a config" #t (hash-table? (read-config "test.config" #f #f)))
(test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f)))

(set! conffile (read-config "test.config" #f #f))
(test "Get available diskspace" #t (number? (get-df "./")))
︙
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45

35
36
37
38
39
40
41

42
43
44
45
46
47
48
49








-
+








(define *db* #f)
(test "setup for run" #t (begin (setup-for-run)
				(string? (getenv "MT_RUN_AREA_HOME"))))
(test "open-db" #t (begin
		     (set! *db* (open-db))
		     (if *db* #t #f)))

;; quit wasting time changing db to *db*
;; quit wasting time, I'm changing *db* to db
(define db *db*)

(test "get cpu load" #t (number? (get-cpu-load)))
(test "get uname"    #t (string? (get-uname)))

(test "get validvalues as list" (list "start" "end" "completed")
      (string-split (config-lookup *configdat* "validvalues" "state")))
︙
72
73
74
75
76
77
78

79
80
81
82
83
84
85

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90








+








		 '("bar" "foo" ":runname" "bob" ":sysname" "ubuntu" ":fsname" "nfs" ":datapath" "blah/foo" "nada")
		 (list ":runname" ":state" ":status")
		 (list "-h")
		 args:arg-hash
		 0))

(test "register-run" #t (number? (register-run *db* (db-get-keys *db*))))
(define keys (db-get-keys *db*))

;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada" 
(setenv "BLAHFOO" "1234")
(unsetenv "NADAFOO")
(test "env temp overrides" "xyz" (let ((prevvals (alist->env-vars '(("BLAHFOO" 4321)("NADAFOO" xyz))))
				       (result   (get-environment-variable "NADAFOO")))
				    (alist->env-vars prevvals)
︙
93
94
95
96
97
98
99






































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








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

(test "Items assoc" '()(item-assoc->item-list '(("a" "a b c d")("b" "c d e")("c" "")("d"))))
(set! *verbosity* -1)
(test "Items assoc empty items" '()   (item-assoc->item-list '(("A"))))
(set! *verbosity* 1)
(test "Items table" "SEASON" (caadar (item-table->item-list '(("ANIMAL" "Elephant Lion")("SEASON" "Spring Winter")))))
(test "Items table empty items I" '() (item-table->item-list '(("A"))))
(test "Items table empty items II" '() (item-table->item-list '(("A" ""))))

;; Test out the steps code

(define test-id #f)

;; force keepgoing
; (hash-table-set! args:arg-hash "-keepgoing" #t)
(hash-table-set! args:arg-hash "-itempatt" "%")
(hash-table-set! args:arg-hash "-testpatt" "%")
(test "Setup for a run"       #t (begin (setup-for-run) #t))
(test "Remove the rollup run" #t (begin (remove-runs) #t))
(test "Run a test" #t (general-run-call 
		       "-runtests" 
		       "run a test" 
		       (lambda (db keys keynames keyvallst)
			 (let ((test-names '("runfirst")))
			   (run-tests db test-names)))))

(change-directory test-work-dir)
(test "Add a step"  #t
      (begin
	(teststep-set-status! db 1 "runfirst" "firststep" "start" 0 '() "This is a comment")
	(sleep 2)
	(teststep-set-status! db 1 "runfirst" "firststep" "end" "pass" '() "This is a different comment")
	(set! test-id (db:test-get-id (car (db-get-tests-for-run db 1 "runfirst" ""))))
	(number? test-id)))

(test "Get nice table for steps" "2.0s"
      (begin
	(vector-ref (hash-table-ref (db:get-steps-table db test-id) "firststep") 4)))

(hash-table-set! args:arg-hash ":runname" "rollup")

(test "Remove the rollup run" #t (begin (remove-runs) #t))
(test "Rollup the run(s)" #t (begin
			       (runs:rollup-run db keys)
			       #t))

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