Megatest

Check-in [b2e635cc07]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added :units to display on dashboard
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | v1.22
Files: files | file ages | folders
SHA1: b2e635cc072ea446c9521a7edb091009301deb27
User & Date: mrwellan on 2011-08-24 16:08:32
Other Links: manifest | tags
Context
2011-08-30
22:59
Merged WAIVER propagation into trunk and bumped version check-in: 39d81114d3 user: matt tags: trunk
2011-08-29
08:38
Partial implemenation of WAIVER propagation check-in: b94b060f8d user: matt tags: waiver-propagation
2011-08-24
16:08
Added :units to display on dashboard check-in: b2e635cc07 user: mrwellan tags: trunk, v1.22
13:37
Cleaned up the test steps display a bit more check-in: 55d1298d58 user: mrwellan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified Makefile from [1861fd6a83] to [9d2940285c]. 

1
2

3

4
5
6
7
8
9
10
11
12
13

FILES=$(glob *.scm)


megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process.scm runs.scm gui.scm

	csc megatest.scm 

dashboard: dashboard.scm dashboard-tests.scm
	csc dashboard.scm

$(PREFIX)/bin/megatest : megatest
	@echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change
	sleep 5
	cp megatest $(PREFIX)/bin/megatest


|

>
|
>


|








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

# $(glob *.scm) did not work as I expected it to!?

FILES=$(shell ls *.scm)

megatest: $(FILES)
	csc megatest.scm 

dashboard: $(FILES)
	csc dashboard.scm

$(PREFIX)/bin/megatest : megatest
	@echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change
	sleep 5
	cp megatest $(PREFIX)/bin/megatest
︙︙

Modified common.scm from [ccb841b77a] to [ae869b679b].

︙︙
45
46
47
48
49
50
51









52
53
54
55
56
57
58

;; Misc utils
;;======================================================================

(define-inline (debug:print n . params)
  (if (<= n *verbosity*)
      (apply print params)))










(define (get-df path)
  (let* ((df-results (cmd-run->list (conc "df " path)))
	 (space-rx   (regexp "([0-9]+)\\s+([0-9]+)%"))
	 (freespc    #f))
    ;; (write df-results)
    (for-each (lambda (l)
		(let ((match (string-search space-rx l)))








>
>
>
>
>
>
>
>
>








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

;; Misc utils
;;======================================================================

(define-inline (debug:print n . params)
  (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 ""))

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

(define (get-df path)
  (let* ((df-results (cmd-run->list (conc "df " path)))
	 (space-rx   (regexp "([0-9]+)\\s+([0-9]+)%"))
	 (freespc    #f))
    ;; (write df-results)
    (for-each (lambda (l)
		(let ((match (string-search space-rx l)))
︙︙

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

︙︙
21
22
23
24
25
26
27
28




29
30
31
32
33
34
35

			  (iup:label val ; #:expand "HORIZONTAL"
				     ))
			(list "Testname: "
			      "Item path: "
			      "Current state: "
			      "Current status: "
			      "Test comment: "
			      "Test id: "))




		   (list (iup:label "" #:expand "VERTICAL"))))
    (apply iup:vbox  ; #:expand "YES"
	   (list 
	    (store-label "testname"
			 (iup:label (db:test-get-testname  testdat) #:expand "HORIZONTAL")
			 (lambda (testdat)(db:test-get-testname testdat)))
	    (store-label "item-path"








|
>
>
>
>








21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

			  (iup:label val ; #:expand "HORIZONTAL"
				     ))
			(list "Testname: "
			      "Item path: "
			      "Current state: "
			      "Current status: "
			      "Test comment: "
			      "Test id: "
			      "Value: "
			      "Expected value: "
			      "Tolerance: "
			      "Units: "))
		   (list (iup:label "" #:expand "VERTICAL"))))
    (apply iup:vbox  ; #:expand "YES"
	   (list 
	    (store-label "testname"
			 (iup:label (db:test-get-testname  testdat) #:expand "HORIZONTAL")
			 (lambda (testdat)(db:test-get-testname testdat)))
	    (store-label "item-path"
︙︙
55
56
57
58
59
60
61
62





















63
64
65
66
67
68
69

				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-comment testdat)))
	    (store-label "testid"
			 (iup:label "TestId                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-id testdat))))))))






















;;======================================================================
;; Test meta panel
;;======================================================================
(define (test-meta-panel testmeta store-meta)
  (iup:frame 
   #:title "Test Meta Data" ; #:expand "YES"








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








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

				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-comment testdat)))
	    (store-label "testid"
			 (iup:label "TestId                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-id testdat)))
	    (store-label "testvalue"
			 (iup:label "TestValue                          "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-value testdat)))
	    (store-label "testexpectedvalue"
			 (iup:label "TestExpectedValue                  "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-expected_value testdat)))
	    (store-label "testtol"
			 (iup:label "TestTol                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-tol testdat)))
	    (store-label "testunits"
			 (iup:label "TestUnits                          "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (db:test-get-units testdat)))
	    )))))

;;======================================================================
;; Test meta panel
;;======================================================================
(define (test-meta-panel testmeta store-meta)
  (iup:frame 
   #:title "Test Meta Data" ; #:expand "YES"
︙︙

Modified db.scm from [6ded946f86] to [9f0642f78d].

︙︙
128
129
130
131
132
133
134

135
136
137
138
139
140
141

	    (list 
	     "ALTER TABLE tests ADD COLUMN expected_value REAL;" ;; DO NOT Add a default, we want it to be NULL
	     "ALTER TABLE tests ADD COLUMN value REAL;"
	     "ALTER TABLE tests ADD COLUMN tol REAL;"
	     "ALTER TABLE tests ADD COLUMN tol_perc REAL;"
	     "ALTER TABLE tests ADD COLUMN first_err TEXT;"
	     "ALTER TABLE tests ADD COLUMN first_warn TEXT;"

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

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








>








128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

	    (list 
	     "ALTER TABLE tests ADD COLUMN expected_value REAL;" ;; DO NOT Add a default, we want it to be NULL
	     "ALTER TABLE tests ADD COLUMN value REAL;"
	     "ALTER TABLE tests ADD COLUMN tol REAL;"
	     "ALTER TABLE tests ADD COLUMN tol_perc REAL;"
	     "ALTER TABLE tests ADD COLUMN first_err TEXT;"
	     "ALTER TABLE tests ADD COLUMN first_warn TEXT;"
	     "ALTER TABLE tests ADD COLUMN units TEXT;"
	     ))))
     (if (< mver megatest-version)
	 (db:set-var db "MEGATEST_VERSION" megatest-version)))))

;;======================================================================
;; meta get and set vars
;;======================================================================
︙︙
278
279
280
281
282
283
284






285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

(define-inline (db:test-get-rundir       vec) (vector-ref vec 10))
(define-inline (db:test-get-item-path    vec) (vector-ref vec 11))
(define-inline (db:test-get-run_duration vec) (vector-ref vec 12))
(define-inline (db:test-get-final_logf   vec) (vector-ref vec 13))
(define-inline (db:test-get-comment      vec) (vector-ref vec 14))
(define-inline (db:test-get-fullname     vec)
  (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))







(define-inline (db:test-set-testname! vec val)(vector-set! vec 2 val))
(define-inline (db:test-set-state!    vec val)(vector-set! vec 3 val))
(define-inline (db:test-set-status!   vec val)(vector-set! vec 4 val))

(define (db-get-tests-for-run db run-id . params)
  (let ((res '())
	(testpatt (if (or (null? params)(not (car params))) "%" (car params)))
	(itempatt (if (> (length params) 1)(cadr params) "%")))
    (sqlite3:for-each-row 
     (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
       (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
     db 
     "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? ORDER BY id DESC;"
     run-id testpatt (if itempatt itempatt "%"))
    res))

;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db run-id test-name itemdat)
  (sqlite3:execute db "DELETE FROM test_steps WHERE test_id in (SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?);" 
		   run-id test-name (item-list->path itemdat)))








>
>
>
>
>
>










|
|

|








279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312

(define-inline (db:test-get-rundir       vec) (vector-ref vec 10))
(define-inline (db:test-get-item-path    vec) (vector-ref vec 11))
(define-inline (db:test-get-run_duration vec) (vector-ref vec 12))
(define-inline (db:test-get-final_logf   vec) (vector-ref vec 13))
(define-inline (db:test-get-comment      vec) (vector-ref vec 14))
(define-inline (db:test-get-fullname     vec)
  (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
(define-inline (db:test-get-value        vec) (printable (vector-ref vec 15)))
(define-inline (db:test-get-expected_value vec)(printable (vector-ref vec 16)))
(define-inline (db:test-get-tol          vec) (printable (vector-ref vec 17)))
(define-inline (db:test-get-units        vec) (printable (vector-ref vec 18)))
(define-inline (db:test-get-first_err    vec) (printable (vector-ref vec 19)))
(define-inline (db:test-get-first_warn   vec) (printable (vector-ref vec 20)))

(define-inline (db:test-set-testname! vec val)(vector-set! vec 2 val))
(define-inline (db:test-set-state!    vec val)(vector-set! vec 3 val))
(define-inline (db:test-set-status!   vec val)(vector-set! vec 4 val))

(define (db-get-tests-for-run db run-id . params)
  (let ((res '())
	(testpatt (if (or (null? params)(not (car params))) "%" (car params)))
	(itempatt (if (> (length params) 1)(cadr params) "%")))
    (sqlite3:for-each-row 
     (lambda (id 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)
       (set! res (cons (vector id 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) res)))
     db 
     "SELECT id,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 FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? ORDER BY id DESC;"
     run-id testpatt (if itempatt itempatt "%"))
    res))

;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db run-id test-name itemdat)
  (sqlite3:execute db "DELETE FROM test_steps WHERE test_id in (SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?);" 
		   run-id test-name (item-list->path itemdat)))
︙︙
349
350
351
352
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

     "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;" run-id)
    res))

;; NB// Sync this with runs:get-test-info
(define (db:get-test-info db run-id testname item-path)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
       (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)))
     db 
     "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
     run-id testname item-path)
    res))

;; Get test data using test_id
(define (db:get-test-data-by-id db test-id)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
       (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)))
     db 
     "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;"
     test-id)
    res))


(define (db:test-set-comment db run-id testname item-path comment)
  (sqlite3:execute 
   db 








|
|

|







|
|

|








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

     "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;" run-id)
    res))

;; NB// Sync this with runs:get-test-info
(define (db:get-test-info db run-id testname item-path)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (id 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)
       (set! res (vector id 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)))
     db 
     "SELECT id,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 FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
     run-id testname item-path)
    res))

;; Get test data using test_id
(define (db:get-test-data-by-id db test-id)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (id 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)
       (set! res (vector id 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)))
     db 
     "SELECT id,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 FROM tests WHERE id=?;"
     test-id)
    res))


(define (db:test-set-comment db run-id testname item-path comment)
  (sqlite3:execute 
   db
︙︙

Modified megatest.scm from [3218809c9e] to [1ec4b37821].

︙︙
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53

  :state                  : required if updating step state; e.g. start, end, completed
  :status                 : required if updating step status; e.g. pass, fail, n/a

Values and record errors and warnings
  -set-values             : update or set values in the megatest db 
  :value                  : value measured
  :expected_value         : value expected
  :tol                    : tolerance |value-expect| <= tol

  :first_err              : record an error message
  :first_warn             : record a warning message

Queries
  -list-runs patt         : list runs matching pattern \"patt\", % is the wildcard
  -testpatt patt          : in list-runs show only these tests, % is the wildcard
  -itempatt patt          : in list-runs show only tests with items that match patt








|
>








39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

  :state                  : required if updating step state; e.g. start, end, completed
  :status                 : required if updating step status; e.g. pass, fail, n/a

Values and record errors and warnings
  -set-values             : update or set values in the megatest db 
  :value                  : value measured
  :expected_value         : value expected
  :tol                    : |value-expect| <= tol
  :units                  : name of the units for value, expected_value and tol
  :first_err              : record an error message
  :first_warn             : record a warning message

Queries
  -list-runs patt         : list runs matching pattern \"patt\", % is the wildcard
  -testpatt patt          : in list-runs show only these tests, % is the wildcard
  -itempatt patt          : in list-runs show only tests with items that match patt
︙︙
107
108
109
110
111
112
113

114
115
116
117
118
119
120

			"-to"
			;; values and messages
			":first_err"
			":first_warn"
			":value"
			":expected_value"
			":tol"

			;; misc
			"-debug" ;; for *verbosity* > 2
			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"








>








108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

			"-to"
			;; values and messages
			":first_err"
			":first_warn"
			":value"
			":expected_value"
			":tol"
			":units"
			;; misc
			"-debug" ;; for *verbosity* > 2
			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"
︙︙
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660

				(else status)))
		    ;; transfer relevant keys into a hash to be passed to test-set-status!
		    ;; could use an assoc list I guess. 
		    (otherdata (let ((res (make-hash-table)))
				 (for-each (lambda (key)
					     (if (args:get-arg key)
						 (hash-table-set! res key (args:get-arg key))))
					   (list ":value" ":tol" ":expected_value" ":first_err" ":first_warn"))
				 res)))
		(if (and (args:get-arg "-test-status")
			 (or (not state)
			     (not status)))
		    (begin
		      (debug:print 0 "ERROR: You must specify :state and :status with every call to -test-status\n" help)
		      (sqlite3:finalize! db)








|








648
649
650
651
652
653
654
655
656
657
658
659
660
661
662

				(else status)))
		    ;; transfer relevant keys into a hash to be passed to test-set-status!
		    ;; could use an assoc list I guess. 
		    (otherdata (let ((res (make-hash-table)))
				 (for-each (lambda (key)
					     (if (args:get-arg key)
						 (hash-table-set! res key (args:get-arg key))))
					   (list ":value" ":tol" ":expected_value" ":first_err" ":first_warn" ":units"))
				 res)))
		(if (and (args:get-arg "-test-status")
			 (or (not state)
			     (not status)))
		    (begin
		      (debug:print 0 "ERROR: You must specify :state and :status with every call to -test-status\n" help)
		      (sqlite3:finalize! db)
︙︙

Modified runs.scm from [0a86a73c3e] to [19e8e11b2f].

︙︙
116
117
118
119
120
121
122



123
124
125
126
127
128
129

    (let ((val (hash-table-ref/default otherdat ":first_err" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; :first_warn
    (let ((val (hash-table-ref/default otherdat ":first_warn" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET first_warn=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))



    ;; :tol_perc
    (let ((val (hash-table-ref/default otherdat ":tol_perc" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET tol_perc=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))

    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (and (not (equal? item-path ""))








>
>
>








116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132

    (let ((val (hash-table-ref/default otherdat ":first_err" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; :first_warn
    (let ((val (hash-table-ref/default otherdat ":first_warn" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET first_warn=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    (let ((val (hash-table-ref/default otherdat ":units" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET units=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
    ;; :tol_perc
    (let ((val (hash-table-ref/default otherdat ":tol_perc" #f)))
      (if val
	  (sqlite3:execute db "UPDATE tests SET tol_perc=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))

    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (and (not (equal? item-path ""))
︙︙

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