Megatest

Diff
Login

Differences From Artifact [3cc17ecae4]:

To Artifact [e167b54c9d]:


14
15
16
17
18
19
20






21
22
23
24
25
26
27
28
29
30
31
32
33



34
35
36
37
38
39
40
41
42
43
44
45
46
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36



37
38
39
40
41
42
43
44

45
46
47
48
49
50
51







+
+
+
+
+
+










-
-
-
+
+
+





-







;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (uses common))
(declare (uses debugprint))
(declare (uses megatest-version))
(declare (uses mtargs))
(declare (uses commonmod))

(use format)

(use (prefix iup iup:))

(use canvas-draw)
(import canvas-draw-iup)

(use sql-de-lite srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors ;; defstruct
     (prefix dbi dbi:))

(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(import commonmod
	debugprint
	(prefix mtargs args:))

;; (declare (uses launch))
;; (declare (uses gutils))
;; (declare (uses db))
;; (declare (uses server))
;; (declare (uses synchash))
(declare (uses dcommon))
;; (declare (uses tree))
;; 
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")

414
415
416
417
418
419
420

421


422
423
424
425
426
427
428
419
420
421
422
423
424
425
426

427
428
429
430
431
432
433
434
435







+
-
+
+







			    #:expand "YES"
			    ;; #:scrollbar "YES"
			    #:numcol 1
			    #:numlin 4
			    #:numcol-visible 1
			    #:numlin-visible 4
			    #:click-cb (lambda (obj lin col status)
					 #f
					 (print "obj: " obj " lin: " lin " col: " col " status: " status))))
					 ;;(print "obj: " obj " lin: " lin " col: " col " status: " status)
					 )))
	 (test-info-matrix (iup:matrix
		            #:expand "YES"
		            #:numcol 1
		            #:numlin 7
		            #:numcol-visible 1
		            #:numlin-visible 7))
	 (test-run-matrix  (iup:matrix
553
554
555
556
557
558
559
560


561
562
563
564
565
566
567
560
561
562
563
564
565
566

567
568
569
570
571
572
573
574
575







-
+
+







		    (lambda (obj id state)
		      ;; (print "obj: " obj ", id: " id ", state: " state)
		      (let* ((run-path (tree:node->path obj id))
			     (test-id  (tree-path->test-id (cdr run-path))))
			;; (if test-id
			;;     (hash-table-set! (dboard:data-curr-test-ids *data*)
			;; 		     window-id test-id))
			(print "path: " (tree:node->path obj id) " test-id: " test-id))))))
			;; (print "path: " (tree:node->path obj id) " test-id: " test-id)
			)))))
     (iup:attribute-set! tb "VALUE" "0")
     (iup:attribute-set! tb "NAME" "Runs")
     ;;(iup:attribute-set! tb "ADDEXPANDED" "NO")
     ;; (dboard:data-tests-tree-set! *data* tb)
     tb)
   (test-panel window-id)))

661
662
663
664
665
666
667

668


669
670
671
672
673
674
675
669
670
671
672
673
674
675
676

677
678
679
680
681
682
683
684
685







+
-
+
+







			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 7
			   #:numlin-visible 7
			   #:click-cb (lambda (obj lin col status)
					#f
					(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
					;; (print "obj: " obj " lin: " lin " col: " col " status: " status)
					))))

    (iup:attribute-set! runs-matrix "RESIZEMATRIX" "YES")
    (iup:attribute-set! runs-matrix "WIDTH0" "100")

    ;; (dboard:data-runs-matrix-set! *data* runs-matrix)
    (iup:hbox
     (iup:frame