Megatest

Diff
Login

Differences From Artifact [03e01ee6e0]:

To Artifact [f1d9d3d3f8]:


1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778














1779



1780
1781
1782



1783
1784
1785
1786
1787
1788






1789
1790
1791



1792
1793
1794
1795


1796
1797
1798
1799
1800
1801
1802
1803










1804
1805
1806
1807
1808
1809
1810
1763
1764
1765
1766
1767
1768
1769









1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787



1788
1789
1790






1791
1792
1793
1794
1795
1796



1797
1798
1799




1800
1801








1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818







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

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







				       ;; 		 (run-id   (db:test-get-run_id (vector-ref buttndat 3)))
				       ;; 		 (cmd  (conc toolpath " -test " run-id "," test-id "&")))
				       ;; ;(print "Launching " cmd)
				       ;; 	    (system cmd)))
                                       #: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 0)
                                                             (let ((popup-menu (iup:menu 
                                                                                (iup:menu-item
                                                                                 "Run"
                                                                                 (iup:menu              
                                                                                  (iup:menu-item
                                                                                   "Rerun"
                                                                                   #:action
                                                                                   (lambda (obj)(print "Rerun")))
                                                          (if (eq? pressed 1)
                                                              (let* ((toolpath (car (argv)))
                                                                     (buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
                                                                     (test-id  (db:test-get-id (vector-ref buttndat 3)))
                                                                     (run-id   (db:test-get-run_id (vector-ref buttndat 3)))
                                                                     (test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id)))
                                                                     (popup-menu (iup:menu 
                                                                                  (iup:menu-item
                                                                                   "Run"
                                                                                   (iup:menu              
                                                                                    (iup:menu-item
                                                                                     "Rerun"
                                                                                     #:action
                                                                                     (lambda (obj)(print "Rerun")))))
                                                                                  (iup:menu-item
                                                                                   "Test"
                                                                                   (iup:menu 
                                                                                    (iup:menu-item
                                                                                   "Start xterm"
                                                                                   #:action
                                                                                   (let* ((toolpath (car (argv)))
                                                                                     "Start xterm"
                                                                                     #:action
                                                                                     (lambda (obj)
                                                                                          (buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
                                                                                          (test-id  (db:test-get-id (vector-ref buttndat 3)))
                                                                                          (run-id   (db:test-get-run_id (vector-ref buttndat 3)))
                                                                                          (cmd  (conc toolpath " -xterm " run-id "," test-id "&")))
                                                                                     (system cmd))
                                                                                   ;; (lambda (x)
                                                                                       (let* ((cmd (conc toolpath " -xterm " run-id "," test-id "&")))
                                                                                         (system cmd))))
                                                                                    (iup:menu-item
                                                                                     "Edit testconfig"
                                                                                     #:action
                                                                                     (lambda (obj)
                                                                                   ;;            (if (directory-exists? rundir)
                                                                                   ;;                (let ((shell (if (get-environment-variable "SHELL") 
                                                                                   ;;                                 (conc "-e " (get-environment-variable "SHELL"))
                                                                                       (let* ((all-tests (tests:get-all))
                                                                                              (editor (or (get-environment-variable "VISUAL")
                                                                                                          (get-environment-variable "EDITOR") "gvim"))
                                                                                   ;;                                 "")))
                                                                                   ;;                  (common:without-vars
                                                                                   ;;                   (conc "cd " rundir 
                                                                                   ;;                         ";mt_xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")
                                                                                              (tconfig (conc (hash-table-ref all-tests test-name) "/testconfig"))
                                                                                              (cmd (conc (if (string-search "\\b(vim?|nano|pico)\\b")
                                                                                   ;;                   "MT_.*"))
                                                                                   ;;                (message-window  (conc "Directory " rundir " not found"))))
                                                                                   ))))))
                                                               (iup:show popup-menu
                                                                         #:x 'mouse
                                                                         #:y 'mouse
                                                                         #:modal? "NO")
                                                               (print "got here")))
                                                                                                             (conc "xterm -e " editor)
                                                                                                             editor)
                                                                                                         " " tconfig)))
                                                                                         (system cmd))))
                                                                                    )))))
                                                                (iup:show popup-menu
                                                                          #:x 'mouse
                                                                          #:y 'mouse
                                                                          #:modal? "NO")
                                                                (print "got here")))
                                                         (if (eq? pressed 0)
                                                             (let* ((toolpath (car (argv)))
                                                                    (buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
                                                                    (test-id  (db:test-get-id (vector-ref buttndat 3)))
                                                                    (run-id   (db:test-get-run_id (vector-ref buttndat 3)))
                                                                    (cmd  (conc toolpath " -test " run-id "," test-id "&")))
                                                               (system cmd)))