Megatest

Check-in [f2ad9ca9c4]
Login
Overview
Comment:Fixed up Makefile to install mt_ files in PREFIX
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | fixup
Files: files | file ages | folders
SHA1: f2ad9ca9c454e6af03c52b6a904ee6ed9884aecc
User & Date: mrwellan on 2011-09-26 11:22:05
Other Links: branch diff | manifest | tags
Context
2011-09-28
10:10
Fixed bug check-in: ab830bcc7c user: mrwellan tags: fixup (unpublished)
2011-09-26
11:22
Fixed up Makefile to install mt_ files in PREFIX check-in: f2ad9ca9c4 user: mrwellan tags: fixup (unpublished)
00:56
Added -keepgoing to default run command in dashboard-test.scm check-in: 7a84f9fe01 user: matt tags: trunk
Changes

Modified Makefile from [9de48ecb2b] to [42bf34d826].

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

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
-
+
+


+









-
+

+
-
-
+
+
+




+
+

-
+




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

PREFIX=.

FILES=$(shell ls *.scm)
HELPERS=$(addprefix $(PREFIX)/bin/,mt_laststep mt_runstep)

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
	sleep 2 
	cp megatest $(PREFIX)/bin/megatest

	cp utils/mt_* $(PREFIX)/bin
	chmod a+x $(PREFIX)/bin/mt_*
$(HELPERS)  : utils/mt_*
	cp $< $@
	chmod a+x $@

# install dashboard as dboard so wrapper script can be called dashboard
$(PREFIX)/bin/dboard : dashboard $(FILES)
	cp dashboard $(PREFIX)/bin/dboard
	utils/mk_dashboard_wrapper $(PREFIX) > $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard

install : $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard
install : $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS)

test: tests/tests.scm
	cd tests;csi -I .. -b -n tests.scm

Modified dashboard-tests.scm from [664f2af223] to [73e81be525].

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
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







-
+



















-
+







					(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 "70x"
							 #: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 "70x"
							 #: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)
344
345
346
347
348
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
378
379
344
345
346
347
348
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
378
379







-
-
-
-
-
+
+
+
+
+
















-
+







		(test-info-panel testdat store-label widgets)
		(test-meta-panel testmeta store-meta))
	       (host-info-panel testdat store-label)
	       ;; The controls
	       (iup:frame #:title "Actions" 
			  (iup:vbox
			   (iup:hbox 
			    (iup:button "View Log"    #:action viewlog     #:size "120x")
			    (iup:button "Start Xterm" #:action xterm       #:size "120x")
			    (iup:button "Run Test"    #:action run-test    #:size "120x")
			    (iup:button "Clean Test"  #:action remove-test #:size "120x")
			    (iup:button "Close"       #:action (lambda (x)(exit)) #:size "120x"))
			    (iup:button "View Log"    #:action viewlog     #:size "80x")
			    (iup:button "Start Xterm" #:action xterm       #:size "80x")
			    (iup:button "Run Test"    #:action run-test    #:size "80x")
			    (iup:button "Clean Test"  #:action remove-test #:size "80x")
			    (iup:button "Close"       #:action (lambda (x)(exit)) #:size "80x"))
			   (apply 
			    iup:hbox
			    (list command-text-box command-launch-button))))
	       (set-fields-panel test-id testdat)
	       (iup:hbox
		(iup:frame 
		 #:title "Test Steps"
		 (let ((stepsdat ;;(iup:label "Test steps ........................................." 
			;;	   #:expand "YES" 
			;;	   #:size "200x150"
			;;	   #:alignment "ALEFT:ATOP")))
			(iup:textbox ;; #:action (lambda (obj char val)
				     ;;    	#f)
				     #:expand "YES"
				     #:multiline "YES"
				     #:font "Courier New, -10"
				     #:size "100x150")))
				     #:size "60x100")))
		   (hash-table-set! widgets "Test Steps" 
				    (lambda (testdat)
				      (let* ((currval (iup:attribute stepsdat "VALUE")) ;; "TITLE"))
					     (fmtstr  "~20a~10a~10a~12a~15a")
					     (comprsteps (db:get-steps-table db test-id))
					     (newval  (string-intersperse 
						       (append
406
407
408
409
410
411
412
413

414
415
416
417
418
419
420
406
407
408
409
410
411
412

413
414
415
416
417
418
419
420







-
+







		 #:title "Test Data"
		 (let ((test-data
			(iup:textbox  ;; #:action (lambda (obj char val)
				      ;;   	#f)
				      #:expand "YES"
				      #:multiline "YES"
				      #:font "Courier New, -10"
				      #:size "100x150")))
				      #:size "100x100")))
		   (hash-table-set! widgets "Test Data"
				    (lambda (testdat) ;; 
				      (let* ((currval (iup:attribute test-data "VALUE")) ;; "TITLE"))
					     (fmtstr  "~10a~10a~10a~10a~7a~7a~6a~a") ;; category,variable,value,expected,tol,units,comment
					     (newval  (string-intersperse 
						       (append
							(list 

Modified db.scm from [4f7891c314] to [a44087c573].

530
531
532
533
534
535
536
537
538



539
540
541
542
543
544
545



546
547
548
549
550
551





552
553
554
555
556
557
558


559
560
561
562
563
564
565
530
531
532
533
534
535
536


537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552



553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573







-
-
+
+
+







+
+
+



-
-
-
+
+
+
+
+







+
+







	      (comment     (list-ref padded-row 6))
	      (status      (let ((s (list-ref padded-row 7)))
			     (if (and (string? s)(or (string-match (regexp "^\\s*$") s)
						     (string-match (regexp "^n/a$") s)))
				 #f
				 s)))) ;; if specified on the input then use, else calculate
	 ;; look up expected,tol,units from previous best fit test if they are all either #f or ''
	 (debug:print 4 "category: " category ", variable: " variable ", value: " value 
		      ", expected: " expected ", tol: " tol ", units: " units ", status: " status ", comment: " comment)
	 (debug:print 4 "BEFORE: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)

	 (if (and (or (not expected)(equal? expected ""))
		  (or (not tol)     (equal? expected ""))
		  (or (not units)   (equal? expected "")))
	     (let-values (((new-expected new-tol new-units)(db:get-prev-tol-for-test db test-id category variable)))
	       (set! expected new-expected)
	       (set! tol      new-tol)
	       (set! units    new-units)))

	 (debug:print 4 "AFTER:  category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 ;; calculate status if NOT specified
	 (if (and (not status)(number? expected)(number? value)) ;; need expected and value to be numbers
	     (if (number? tol) ;; if tol is a number then we do the standard comparison
		 (let ((max-val (+ expected tol))
		       (min-val (- expected tol)))
		   (set! status (if (and (>=  value min-val)(<= value max-val)) "pass" "fail")))
		 (let* ((max-val (+ expected tol))
			(min-val (- expected tol))
			(result  (and (>=  value min-val)(<= value max-val))))
		   (debug:print 4 "max-val: " max-val " min-val: " min-val " result: " result)
		   (set! status (if result "pass" "fail")))
		 (set! status ;; NB// need to assess each one (i.e. not return operator since need to act if not valid op.
		       (case (string->symbol tol) ;; tol should be >, <, >=, <=
			 ((>)  (if (>  value expected) "pass" "fail"))
			 ((<)  (if (<  value expected) "pass" "fail"))
			 ((>=) (if (>= value expected) "pass" "fail"))
			 ((<=) (if (<= value expected) "pass" "fail"))
			 (else (conc "ERROR: bad tol comparator " tol))))))
	 (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status) VALUES (?,?,?,?,?,?,?,?,?);"
	      test-id category variable value expected tol units (if comment comment "") status)))
     csvlist)))

;; get a list of test_data records matching categorypatt
(define (db:read-test-data db test-id categorypatt)
  (let ((res '()))

Added utils/mk_dashboard_wrapper version [37e41509e7].












1
2
3
4
5
6
7
8
9
10
11
+
+
+
+
+
+
+
+
+
+
+
#!/bin/bash

prefix=$1
echo "#!/bin/bash"
if [ $LD_LIBRARY_PATH != "" ];then
  echo "export LD_LIBRARY_PATH=$LD_LIBRARY_PATH"
fi

dboard=`realpath $prefix/bin/dboard`

echo "$dboard \$*"

Modified utils/mt_laststep from [3e6695b426] to [7710982a12].

1





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

+
+
+
+
+







#!/bin/bash

if [ $MT_CMDINFO == "" ];then
  echo "ERROR: $0 should be run within a megatest test environment"
  exit
fi

# Purpose: run a step, record start and end with exit codes, if sucessful
# update test status with PASS, else update with FAIL
#
# Call like this:
# mt_laststep stepname command ....
#