Megatest

Check-in [25464d7c31]
Login
Overview
Comment:Merged v1.65 fixes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-ulex-try-again
Files: files | file ages | folders
SHA1: 25464d7c31b5b9dca5dca09ab6f72309cdbb658a
User & Date: matt on 2020-12-29 11:42:45
Other Links: branch diff | manifest | tags
Context
2020-12-29
16:17
Bits 'n pieces in place check-in: e2202d843d user: matt tags: v1.65-ulex-try-again
11:42
Merged v1.65 fixes check-in: 25464d7c31 user: matt tags: v1.65-ulex-try-again
2020-12-22
15:07
Make text bold on buttons check-in: fe23e23b3c user: mrwellan tags: v1.65
2020-12-17
21:23
Merged v1.65 check-in: a23cf8b5b9 user: matt tags: v1.65-ulex-try-again
Changes

Modified dashboard-tests.scm from [237d160a6c] to [775d2ec086].

322
323
324
325
326
327
328
329
330


331
332
333
334
335
336
337
322
323
324
325
326
327
328


329
330
331
332
333
334
335
336
337







-
-
+
+







				(map cadr *common:std-states*)))) ;; (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "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))))
				   (if (not (colors-similar? newcolor (iup:attribute btn "FGCOLOR")))
				       (iup:attribute-set! btn "FGCOLOR" newcolor))))
			       btns)))
	       btns))
      (apply iup:hbox
	     (iup:label "STATUS:" #:size "30x")
	     (let* ((btns  (map (lambda (status)
				  (let ((btn (iup:button status
							 #:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10"
356
357
358
359
360
361
362
363
364


365
366
367
368
369
370
371
356
357
358
359
360
361
362


363
364
365
366
367
368
369
370
371







-
-
+
+







				(map cadr *common:std-statuses*)))) ;; (list  "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED" "SKIP"))))
	       (vector-set! *state-status* 1
			    (lambda (status color)
			      (for-each 
			       (lambda (btn)
				 (let* ((name     (iup:attribute btn "TITLE"))
					(newcolor (if (equal? name status) color "192 192 192")))
				   (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
				       (iup:attribute-set! btn "BGCOLOR" newcolor))))
				   (if (not (colors-similar? newcolor (iup:attribute btn "FGCOLOR")))
				       (iup:attribute-set! btn "FGCOLOR" newcolor))))
			       btns)))
	       btns))))))

(define (dashboard-tests:run-a-step info)
  #t)

;; (define (dashboard-tests:step-run-control testdat stepname testconfig)

Modified dashboard.scm from [627ca6b765] to [b5170fbef9].

1167
1168
1169
1170
1171
1172
1173
1174


1175
1176

1177
1178
1179
1180
1181
1182
1183
1167
1168
1169
1170
1171
1172
1173

1174
1175
1176

1177
1178
1179
1180
1181
1182
1183
1184







-
+
+

-
+







					  (else
					   teststate)))
			   (button     (vector-ref columndat rown))
			   (color      (car (gutils:get-color-for-state-status teststate teststatus)))
			   (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
			   (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
		      (if (not (equal? curr-color color))
			  (iup:attribute-set! button "BGCOLOR" color))
			  #;(iup:attribute-set! button "BGCOLOR" color)
			  (iup:attribute-set! button "FGCOLOR" color))
		      (if (not (equal? curr-title buttontxt))
			  (iup:attribute-set! button "TITLE"   buttontxt))
			  (iup:attribute-set! button "TITLE" (conc "<span weight=\"bold\">"  buttontxt "</span>")))
		      (vector-set! buttondat 0 run-id)
		      (vector-set! buttondat 1 color)
		      (vector-set! buttondat 2 buttontxt)
		      (vector-set! buttondat 3 testdat)
		      (vector-set! buttondat 4 run-key)))
		(set! rown (+ rown 1))))
	    (dboard:tabdat-all-test-names tabdat)))
2498
2499
2500
2501
2502
2503
2504
2505
2506


2507
2508
2509
2510
2511
2512
2513


2514
2515
2516


2517
2518
2519
2520
2521
2522
2523
2499
2500
2501
2502
2503
2504
2505


2506
2507
2508
2509
2510
2511
2512


2513
2514
2515


2516
2517
2518
2519
2520
2521
2522
2523
2524







-
-
+
+





-
-
+
+

-
-
+
+







	   ;; 					   (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-empty-runs tabdat) "+HideE" "-HideE"))
	   ;; 					   (mark-for-update tabdat))))
	   (set! hide (iup:button "Hide"
				  #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL"
				  #:action (lambda (obj)
					     (dboard:tabdat-hide-not-hide-set! tabdat #t) ;; (not (dboard:tabdat-hide-not-hide tabdat)))
					     ;; (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-not-hide tabdat) "HideTests" "NotHide"))
					     (iup:attribute-set! hide "BGCOLOR" sel-color)
					     (iup:attribute-set! show "BGCOLOR" nonsel-color)
					     (iup:attribute-set! hide "FGCOLOR" sel-color)
					     (iup:attribute-set! show "FGCOLOR" nonsel-color)
					     (mark-for-update tabdat))))
	   (set! show (iup:button "Show"
				  #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL"
				  #:action (lambda (obj)
					     (dboard:tabdat-hide-not-hide-set! tabdat #f) ;; (not (dboard:tabdat-hide-not-hide tabdat)))
					     (iup:attribute-set! show "BGCOLOR" sel-color)
					     (iup:attribute-set! hide "BGCOLOR" nonsel-color)
					     (iup:attribute-set! show "FGCOLOR" sel-color)
					     (iup:attribute-set! hide "FGCOLOR" nonsel-color)
					     (mark-for-update tabdat))))
	   (iup:attribute-set! hide "BGCOLOR" sel-color)
	   (iup:attribute-set! show "BGCOLOR" nonsel-color)
	   (iup:attribute-set! hide "FGCOLOR" sel-color)
	   (iup:attribute-set! show "FGCOLOR" nonsel-color)
	   ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ...
           (iup:vbox
            (iup:hbox hide show)
            sort-lb))) 
	)

        ;; insert extra widget here
2882
2883
2884
2885
2886
2887
2888

2889
2890
2891
2892
2893
2894
2895
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897







+







	(loop (+ runnum 1) 0 (make-vector ntests) '()))
       (else
	(let* ((button-key (mkstr runnum testnum))
	       (butn       (iup:button
			    "" ;; button-key 
			    #:size (conc cell-width btn-height )
			    #:expand "HORIZONTAL"
			    #:MARKUP "YES"
			    #:fontsize btn-fontsz
			    #:button-cb
			    (lambda (obj a pressed x y btn . rem)
			      ;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
			      (if  (substring-index "3" btn)
				   (if (eq? pressed 1)
				       (let* ((toolpath (car (argv)))