Megatest

Changes On Branch v1.65-subrun-dboard
Login

Changes In Branch v1.65-subrun-dboard Excluding Merge-Ins

This is equivalent to a diff from b6bf1dd82b to 2abfcad6eb

2017-11-08
14:07
v1.6504 check-in: 244e676ac0 user: bjbarcla tags: v1.65, v1.6504
2017-11-03
18:14
began subrun dashboard support Leaf check-in: 2abfcad6eb user: bjbarcla tags: v1.65-subrun-dboard
15:57
caught situation where testpatt called for evaluating nonexistent item -- marked test ZERO_ITEMS instead of hanging the run in this case (passes test2) check-in: b6bf1dd82b user: bjbarcla tags: v1.65
11:26
cleaned up some comments Leaf check-in: 456c27dbc6 user: bjbarcla tags: v1.65-test2
2017-11-01
17:10
Merged in log-tail stuff. check-in: 0f8fa0be12 user: mrwellan tags: v1.65

Modified dashboard-tests.scm from [732cc4e623] to [cc72f4bef6].

241
242
243
244
245
246
247
248




249
250
251
252
253
254
255
241
242
243
244
245
246
247

248
249
250
251
252
253
254
255
256
257
258







-
+
+
+
+







			 (lambda (testdat) ;; (sdb:qry 'getstr 
			   (db:test-get-uname testdat))) ;; )
	    )))))

;; if there is a submegatest create a button to launch dashboard in that area
;;
(define (submegatest-panel dbstruct keydat testdat runname testconfig)
  (let* ((subarea (configf:lookup testconfig "setup" "submegatest"))
  (let* ((subarea (or (configf:lookup testconfig "setup" "submegatest")
                      (configf:lookup testconfig "subrun" "runarea")
                      ;; TBD - maybe need to determine auto subrun area
                      ))
	 (area-exists (and subarea (common:file-exists? subarea))))
    ;; (debug:print-info 0 *default-log-port* "Megatest subarea=" subarea ", area-exists=" area-exists)
    (if subarea
	(iup:frame 
	 #:title "Megatest Run Info" ; #:expand "YES"
	 (iup:button
	  "Launch Dashboard"
472
473
474
475
476
477
478
479

480
481
482
483

484
485








486
487
488
489
490
491
492
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







-
+




+


+
+
+
+
+
+
+
+







	       (runconfig  (let ((runconfigf (conc  *toppath* "/runconfigs.config"))) ;; no rush but it would be good to convert this call to use runconfig:read
	 		     (if (common:file-exists? runconfigf)
	 			 (handle-exceptions
                                   exn
                                   #f  ;; do nothing, just keep on trucking ....
                                   (setup-env-defaults runconfigf run-id (make-hash-table) keydat environ-patt: keystring))
	 			 (make-hash-table))))
	       (testconfig    (begin
	       (base-testconfig    (begin ;; TODO: make this work.
				;; (runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path)
				(runs:set-megatest-env-vars run-id inkeyvals: keydat inrunname: runname intarget: keystring testname: testname itempath: item-path) ;; these may be needed by the launching process
				(handle-exceptions
				 exn  ;; NOTE: I've no idea why this was written this way. Research, study and fix needed!

				 (tests:get-testconfig (db:test-get-testname testdat) (db:test-get-item-path testdat) test-registry #f allow-write-cache: #f)
				 (tests:get-testconfig (db:test-get-testname testdat) item-path test-registry #t allow-write-cache: #f))))
               (testconfig (let* ((testpath (db:test-get-rundir testdat))
                                  (subrun-tconfpath (conc testpath "/testconfig.subrun")))
                             (if (file-exists? subrun-tconfpath)
                                 (read-config subrun-tconfpath base-testconfig ...)
                                 base-testconfig)))
               ;; NOTES: (target this addition early 17ww45 for Ritika)
               ;;   1. if testconfig.subrun exists, dont bother with base-testconfig
               ;;   2. if .testconfig exists, do we defer to that? (do we trust it?) ;; answer as of 17ww44: no.
	       (viewlog    (lambda (x)
			     (if (common:file-exists? logfile)
					;(system (conc "firefox " logfile "&"))
				 (dcommon:run-html-viewer logfile)
				 (message-window (conc "File " logfile " not found")))))
	       (view-a-log (lambda (lfile) 
			     (let ((lfilename (conc rundir "/" lfile)))