Megatest

Diff
Login

Differences From Artifact [1ccdb1c663]:

To Artifact [6533588be6]:


1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168



1169
1170
1171


1172
1173

1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194

1195
1196
1197
1198
1199
1200
1201
1154
1155
1156
1157
1158
1159
1160

1161
1162
1163
1164



1165
1166
1167
1168


1169
1170
1171

1172
1173
1174
1175


1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186





1187
1188
1189
1190
1191
1192
1193
1194







-




-
-
-
+
+
+

-
-
+
+

-
+



-
-











-
-
-
-
-
+







     ;; (let ((logs-tb (iup:textbox #:expand "YES"
     ;;				   #:multiline "YES")))
     ;;	 (dboard:tabdat-logs-textbox-set! tabdat logs-tb)
     ;;	 logs-tb))
     )))

(define (dboard:xor-ui-update tabdat)
  (print "BB> ARGH0")
  (let* ((mode-flag (dboard:tabdat-mode-flag tabdat))
         (current-mode (mode-flag))
         (xor-src-runid-label  (dboard:tabdat-xor-src-runid-label tabdat))
         (xor-dest-runid-label (dboard:tabdat-xor-dest-runid-label tabdat))
         (curr-run-id          (begin (print "BB> ARGH1") (dboard:tabdat-curr-run-id tabdat)))
         (prev-run-id          (begin (print "BB> ARGH2") (dboard:tabdat-prev-run-id tabdat)))
         (curr-runname (begin   (print "BB> ARGH3") (if curr-run-id
         (curr-run-id          (dboard:tabdat-curr-run-id tabdat))
         (prev-run-id          (dboard:tabdat-prev-run-id tabdat))
         (curr-runname (if curr-run-id
                           (rmt:get-run-name-from-id curr-run-id)
                           "None")))
         (prev-runname (begin   (print "BB> ARGH4") (if prev-run-id
                           "None"))
         (prev-runname (if prev-run-id
                           (rmt:get-run-name-from-id prev-run-id)
                           "None")))
                           "None"))
         )
    
    (print "BB> xor-ui-update HELLO" )
    (print "BB> xor-src-runid-label="xor-src-runid-label)
    (print "BB> xor-dest-runid-label="xor-dest-runid-label)
    (print "BB> curr-runname="curr-runname)
    (print "BB> prev-runname="prev-runname)
    (print "BB> current-mode="current-mode)
    (case current-mode
      ((view-one-run)
       (iup:attribute-set! xor-src-runid-label "TITLE" "")
       (iup:attribute-set! xor-dest-runid-label "TITLE" ""))
      ((xor-two-runs)
       (iup:attribute-set! xor-src-runid-label "TITLE" (conc " SRC: "curr-runname"  "))
       (iup:attribute-set! xor-dest-runid-label "TITLE" (conc "DEST: "prev-runname"  ")))
      (else (print "BB> WHA?"))
      )
    (print "BB> after case")
    

    ))
      )))

(define (dboard:runs-tree-browser commondat tabdat)
  (let* ((tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:expand "YES"
		   #:addexpanded "NO"
1501
1502
1503
1504
1505
1506
1507
1508



1509

1510
1511
1512
1513
1514
1515
1516


1517
1518

1519



1520
1521
1522
1523
1524
1525
1526
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511


1512
1513
1514
1515
1516

1517
1518
1519
1520
1521
1522
1523
1524
1525
1526








+
+
+

+





-
-
+
+


+
-
+
+
+








      (if (and (eq? pass-num 0) changed)
	  (loop 1 #t)) ;; force second pass due to column labels changing

      ;; (debug:print 0 *default-debug-port* "one-run-updater, changed: " changed " pass-num: " pass-num)
      ;; (print "one-run-updater, changed: " changed " pass-num: " pass-num)
      (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL")))))




(define (dashboard:xor-two-runs-updater commondat tabdat tb cell-lookup run-matrix )
  (print "BB> HeLLooo from xor-two-runs-updater")
  (let* ((runs-dat     (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
	 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
         (prev-run-id       (dboard:tabdat-prev-run-id tabdat))
	 (curr-run-id       (dboard:tabdat-curr-run-id tabdat))
	 (last-update  0) ;; fix me - have to create and store a rundat record for this
	 (curr-tests-dat    (dboard:get-tests-dat tabdat curr-run-id last-update)) ;; does query to get run info
         (prev-tests-dat    (dboard:get-tests-dat tabdat prev-run-id last-update)) ;; does query to get run info
	 (dest-tests-dat    (dboard:get-tests-dat tabdat curr-run-id last-update)) ;; does query to get run info
         (src-tests-dat    (dboard:get-tests-dat tabdat prev-run-id last-update)) ;; does query to get run info

         ;;; STOPPED HERE
         (dest-tests-mindat (dcommon:minimize-test-data dest-tests-dat))  ;; reduces data for display
         (tests-mindat (dcommon:minimize-test-data curr-tests-dat))  ;; reduces data for display
         (src-tests-mindat (dcommon:minimize-test-data src-tests-dat))  ;; reduces data for display
         ;;(tests-mindat dest-tests-mindat)
         (tests-mindat (dcommon:xor-tests-mindat src-tests-mindat dest-tests-mindat)) ;; TODO: flags for common, modified, new -- like meld
	 (indices      (common:sparse-list-generate-index tests-mindat)) ;;  proc: set-cell))
	 (row-indices  (cadr indices))
	 (col-indices  (car indices))
	 (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
	 (max-col      (if (null? col-indices) 1 (common:max (map cadr col-indices))))
	 (max-visible  (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) ;; (dboard:tabdat-num-tests tabdat) is proportional to the size of the window
	 (numrows      1)
1729
1730
1731
1732
1733
1734
1735

1736
1737
1738
1739
1740
1741
1742
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743







+







                                  ))))
    
    (dboard:commondat-add-updater commondat one-run-updater tab-num: tab-num) ;; register updater
    (dboard:tabdat-runs-tree-set! tabdat tb)

    (iup:vbox
     (iup:split
      #:value 150
      (iup:vbox
       tb)
      run-matrix)
     mode-selector)
    ))