Megatest

Check-in [eb63661bd1]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:added color cues for steps matrix in test control panel
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: eb63661bd1476f9156c6cf61534644f5b2d7b6bc
User & Date: bjbarcla on 2018-11-30 17:46:47
Other Links: branch diff | manifest | tags
Context
2018-12-05
16:28
merged feature to preserve environment for test control panel execute button check-in: 74324f583b user: bjbarcla tags: v1.65, v1.6517
2018-12-04
17:47
implemented first level of env var squelching for execute; megatest.config and runconfig.config vars remain to be squelched check-in: a647090d94 user: bjbarcla tags: v1.65-testpanel-execenv
2018-11-30
17:46
added color cues for steps matrix in test control panel check-in: eb63661bd1 user: bjbarcla tags: v1.65
15:49
completed fix of restart step -- refactored to add active columns to step matrix check-in: dbcb3cf9a9 user: bjbarcla tags: v1.65
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard-tests.scm from [87f3e4eff2] to [1243e2b2aa].

︙
741
742
743
744
745
746
747
748

749
750
751
752

753
754
755
756
757
758
759
760
761
762
763
764
765
766



767
768
769
770
771
772
773

741
742
743
744
745
746
747

748
749
750
751

752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776








-
+



-
+














+
+
+








							    #:numlin-visible 5
							    #:click-cb (lambda (obj lin col status)
									 ;; (if (equal? col 6)
									 (let* ((mtrx-rc  (conc lin ":" 6))
										(fname    (iup:attribute obj mtrx-rc))
                                                                                (stepname (iup:attribute obj (conc lin ":" 1)))                                                                                            (comment  (iup:attribute obj (conc lin ":" 7))))
                                                                           (case col
                                                                             ((6) (view-a-log fname))
                                                                             
                                                                             ((7) (print "Comment from step "stepname": "comment))
                                                                             ((8) (ezsteps:spawn-run-from testdat stepname #t))
                                                                             ((9) (ezsteps:spawn-run-from testdat stepname #f))
                                                                             (else (print "No action for col="col))))))))
                                                                             (else (view-a-log fname))))))))
					 ;; (let loop ((count 0))
					 ;;   (iup:attribute-set! steps-matrix "FITTOTEXT" (conc "L" count))
					 ;;   (if (< count 30)
					 ;;       (loop (+ count 1))))
					 (iup:attribute-set! steps-matrix "0:1" "Step Name")
					 (iup:attribute-set! steps-matrix "0:2" "Start")
					 (iup:attribute-set! steps-matrix "0:3" "End")
					 (iup:attribute-set! steps-matrix "WIDTH3" "50")
					 (iup:attribute-set! steps-matrix "0:4" "Status")
					 (iup:attribute-set! steps-matrix "WIDTH4" "50")
					 (iup:attribute-set! steps-matrix "0:5" "Duration")
					 (iup:attribute-set! steps-matrix "0:6" "Log File")
					 (iup:attribute-set! steps-matrix "0:7" "Comment")
                                         (iup:attribute-set! steps-matrix "0:8" "rerun only")
                                         (iup:attribute-set! steps-matrix "BGCOLOR0:9" "149 208 252")
                                         (iup:attribute-set! steps-matrix "BGCOLOR0:8" "149 208 252")
                                         (iup:attribute-set! steps-matrix "BGCOLOR0:7" "149 208 252")
                                         (iup:attribute-set! steps-matrix "0:9" "rerun & continue")
					 (iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT")
					 ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
					 (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
					 (let ((proc
						(lambda (testdat)
						  (dcommon:populate-steps teststeps steps-matrix))))
︙

Modified dcommon.scm from [11f59293fe] to [bd3c15a49b].

︙
1254
1255
1256
1257
1258
1259
1260
1261
1262





1263
1264
1265
1266
1267
1268
1269

1270
1271









1272


1273
1274
1275
1276

1277
1278
1279
1280
1281
1282
1283

1254
1255
1256
1257
1258
1259
1260


1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273


1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288

1289
1290
1291
1292
1293
1294
1295
1296








-
-
+
+
+
+
+







+
-
-
+
+
+
+
+
+
+
+
+

+
+



-
+








     canvas-obj)))

;;======================================================================
;;  S T E P S
;;======================================================================

(define (dcommon:populate-steps teststeps steps-matrix)
  (let ((max-row 0)
	(max-col 9))
  (let ((max-row       0)
	(max-col       9)
        (white         "255 255 255")
        (running-color (car (gutils:get-color-for-state-status "RUNNING" "STARTED")))
        (failcolor     (car (gutils:get-color-for-state-status "COMPLETED" "FAIL"))))
    (if (null? teststeps)
	(iup:attribute-set! steps-matrix "CLEARVALUE" "CONTENTS")
	(let loop ((hed    (car teststeps))
		   (tal    (cdr teststeps))
		   (rownum 1)
		   (colnum 1))
	  (if (> rownum max-row)(set! max-row rownum))
	  (let* ((status  (vector-ref hed 3))
	  (let ((val     (vector-ref hed (- colnum 1)))
		(mtrx-rc (conc rownum ":" colnum)))
                 (val     (vector-ref hed (- colnum 1)))
                 (bgcolor (cond
                           ((member (conc status) '("" "#<unspecified>"))
                            running-color)
                           ((member (conc status) '("0" 0))
                            white)
                           (else failcolor)))
		 (mtrx-rc (conc rownum ":" colnum)))
            ;;(print "BB> status=>"status"< bgcolor="bgcolor)
	    (iup:attribute-set! steps-matrix  mtrx-rc (if val (conc val) ""))
            (if (< colnum 5)
                (iup:attribute-set! steps-matrix  (conc "BGCOLOR" mtrx-rc) bgcolor))
	    (if (< colnum max-col)
		(loop hed tal rownum (+ colnum 1))
		(if (not (null? tal))
		    (loop (car tal)(cdr tal)(+ rownum 1) 1))))))
		    (loop (car tal) (cdr tal) (+ rownum 1) 1))))))
    (if (> max-row 0)
	(begin
	  ;; we are going to speculatively clear rows until we find a row that is already cleared
	  (let loop ((rownum  (+ max-row 1))
		     (colnum  0)
		     (deleted #f))
	    ;; (debug:print-info 0 *default-log-port* "cleaning " rownum ":" colnum)
︙

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