Megatest

Diff
Login

Differences From Artifact [2959a1c9ce]:

To Artifact [8aad97ccf0]:


264
265
266
267
268
269
270
271


272
273

274
275
276
277
278
279
280
264
265
266
267
268
269
270

271
272
273

274
275
276
277
278
279
280
281







-
+
+

-
+







	 (testmeta      (if testdat 
			    (let ((tm (db:testmeta-get-record db testname)))
			      (if tm tm (make-db:testmeta)))
			    (make-db:testmeta)))

	 (keystring  (string-intersperse 
		      (map (lambda (keyval)
			     (conc ":" (car keyval) " " (cadr keyval)))
			     ;; (conc ":" (car keyval) " " (cadr keyval)))
			     (cadr keyval))
			   keydat)
		      " "))
		      "/"))
	 (item-path  (db:test-get-item-path testdat))
	 (viewlog    (lambda (x)
		       (if (file-exists? logfile)
			   ;(system (conc "firefox " logfile "&"))
			   (iup:send-url logfile)
			   (message-window (conc "File " logfile " not found")))))
	 (xterm      (lambda (x)
330
331
332
333
334
335
336
337

338
339
340
341

342
343
344
345

346
347
348
349

350
351
352
353
354
355
356
331
332
333
334
335
336
337

338
339
340
341

342
343
344
345

346
347
348
349

350
351
352
353
354
355
356
357







-
+



-
+



-
+



-
+







	 (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 "megatest -runtests " testname " " keystring " :runname " runname 
		       (conc "megatest -runtests " testname " -target " keystring " :runname " runname 
			     " -itempatt " (if (equal? item-path "")
					       "%" 
					       item-path)
			     " -keepgoing > run.log" ))))
			     "" ))))
	 (remove-test (lambda (x)
			(iup:attribute-set!
			 command-text-box "VALUE"
			 (conc "megatest -remove-runs " keystring " :runname " runname " -testpatt " testname " -itempatt "
			 (conc "megatest -remove-runs -target " keystring " :runname " runname " -testpatt " testname " -itempatt "
			       (if (equal? item-path "")
				   "%"
				   item-path)
			       " > clean.log")))))
			       " -v ")))))
    (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 ; 
	    (iup:dialog #:close_cb (lambda (a)(exit)) ; #:expand "YES"