Megatest

Check-in [70f93b7c02]
Login
Overview
Comment:Clicking on tests in the test map adds/removes test(s) to testpatt
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: 70f93b7c02a4d9f8806caa1f871b64ab1b126ba4
User & Date: matt on 2013-07-08 00:00:37
Other Links: branch diff | manifest | tags
Context
2013-07-08
00:53
Marking of tests to be affected now works check-in: f61fea99bf user: matt tags: dev
00:00
Clicking on tests in the test map adds/removes test(s) to testpatt check-in: 70f93b7c02 user: matt tags: dev
2013-07-07
23:54
Clicking on tests in the test map adds test(s) to testpatt check-in: 56a938ff2e user: matt tags: dev
Changes

Modified dashboard.scm from [24be63be12] to [472dc2a21e].

794
795
796
797
798
799
800
801


802
803
804
805

806
807
808
809
810






811
812
813
814
815
816
817
794
795
796
797
798
799
800

801
802
803
804
805
806
807





808
809
810
811
812
813
814
815
816
817
818
819
820







-
+
+




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







				    (for-each (lambda (test-name)
						(let* ((rec-coords (hash-table-ref tests-info test-name))
						       (llx        (list-ref rec-coords 0))
						       (urx        (list-ref rec-coords 1))
						       (lly        (list-ref rec-coords 2))
						       (ury        (list-ref rec-coords 3)))
						  ;; (print x "\t" y "\t" llx "\t" lly "\t" urx "\t" ury "\t" test-name " "
						  (if (and (> x llx)
						  (if (and (eq? pressed 1)
							   (> x llx)
							   (> y lly)
							   (< x urx)
							   (< y ury))
						      (let ((patterns (string-split (iup:attribute test-patterns-textbox "VALUE"))))
							(let* ((newpatt-list (if (member test-name patterns)
							(if (not (member test-name patterns))
							    (let* ((newpatt (string-intersperse (cons test-name patterns) "\n")))
							      (iup:attribute-set! test-patterns-textbox "VALUE" newpatt)
							      (dboard:data-set-test-patts! *data* (dboard:lines->test-patt newpatt))
							      (dashboard:update-run-command)))))))
										 (delete test-name patterns)
										 (cons test-name patterns)))
							       (newpatt      (string-intersperse newpatt-list "\n")))
							  (iup:attribute-set! test-patterns-textbox "VALUE" newpatt)
							  (dboard:data-set-test-patts! *data* (dboard:lines->test-patt newpatt))
							  (dashboard:update-run-command))))))
					      (hash-table-keys tests-info)))))))
      ;; (print "obj: " obj " btn: " btn " pressed: " pressed " x: " x " y: " y " status: " status))
      
      (iup:frame
       #:title "Logs" ;; To be replaced with tabs
       (let ((logs-tb (iup:textbox #:expand "YES"
				   #:multiline "YES")))