Megatest

Check-in [b6b6ac8553]
Login
Overview
Comment:Added run-id to run info panel, brought launch commands in line with new test spec mechanism
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b6b6ac85535ce4ed170df6032d52070d6fb652f5
User & Date: mrwellan on 2012-10-15 10:38:26
Other Links: manifest | tags
Context
2012-10-15
10:41
Bumped version check-in: 0791ec1f09 user: fdk71adm tags: trunk, v1.50
10:38
Added run-id to run info panel, brought launch commands in line with new test spec mechanism check-in: b6b6ac8553 user: mrwellan tags: trunk
10:06
Added wrapping of test desciption at 40 chars check-in: 1dca81e5c4 user: mrwellan tags: trunk
Changes

Modified dashboard-tests.scm from [629d0b3d1c] to [fa14a1a9fc].

131
132
133
134
135
136
137
138

139
140
141
142
143



144
145
146
147
148
149
150
131
132
133
134
135
136
137

138
139
140
141
142

143
144
145
146
147
148
149
150
151
152







-
+




-
+
+
+







   #:title "Megatest Run Info" ; #:expand "YES"
   (iup:hbox ; #:expand "YES"
    (apply iup:vbox ; #:expand "YES"
	   (append (map (lambda (keyval)
			  (iup:label (conc (car keyval) " ") ; #:expand "HORIZONTAL"
				     ))
			keydat)
		   (list (iup:label "runname "))))
		   (list (iup:label "runname ")(iup:label "run-id"))))
    (apply iup:vbox
	   (append (map (lambda (keyval)
			  (iup:label (cadr keyval) #:expand "HORIZONTAL"))
			keydat)
		   (list (iup:label runname)(iup:label "" #:expand "VERTICAL")))))))
		   (list (iup:label runname)
			 (iup:label (conc (db:test-get-run_id testdat)))
			 (iup:label "" #:expand "VERTICAL")))))))
  
;;======================================================================
;; Host info panel
;;======================================================================
(define (host-info-panel testdat store-label)
  (iup:frame
   #:title "Remote host and Test Run Info" ; #:expand "YES"
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
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







-
-
-
-
+
+
+
+




-
-
-
-
+
+
+
+







	       (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 "xterm -geometry 180x20 -e \"megatest -runtests " testname " -target " keystring " :runname " runname 
				   " -itempatt " (if (equal? item-path "")
						     "%" 
						     item-path)
			     (conc "xterm -geometry 180x20 -e \"megatest -target " keystring " :runname " runname 
				   " -runtests " (conc testname "/" (if (equal? item-path "")
									"%" 
									item-path))
				   ";echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
	       (remove-test (lambda (x)
			      (iup:attribute-set!
			       command-text-box "VALUE"
			       (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " :runname " runname " -testpatt " testname " -itempatt "
				     (if (equal? item-path "")
					 "%"
					 item-path)
			       (conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " :runname " runname
				     " -testpatt " (conc testname "/" (if (equal? item-path "")
									  "%"
									  item-path))
				     " -v;echo Press any key to continue;bash -c 'read -n 1 -s'\"")))))
	  (cond
	   ((not testdat)(begin (print "ERROR: bad test info for " test-id)(exit 1)))
	   ((not rundat)(begin (print "ERROR: found test info but there is a problem with the run info for " run-id)(exit 1)))
	   (else
	    ;;  (test-set-status! db run-id test-name state status itemdat)
	    (set! self ;