Megatest

Diff
Login

Differences From Artifact [56ecab23d3]:

To Artifact [747c3edf8a]:


17
18
19
20
21
22
23
24


25
26
27
28
29
30
31
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
32







-
+
+







;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================
;; launch a task - this runs on the originating host, tests themselves
;;
;;======================================================================

(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables csv)
(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3
     call-with-environment-variables csv)
(use typed-records pathname-expand matchable)

(import (prefix base64 base64:))
(import (prefix sqlite3 sqlite3:))

(declare (unit launch))
(declare (uses subrun))
1608
1609
1610
1611
1612
1613
1614
1615




1616
1617
1618
1619
1620
1621
1622
1609
1610
1611
1612
1613
1614
1615

1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626







-
+
+
+
+







	   (diskpath   #f)
	   (cmdparms   #f)
	   (fullcmd    #f) ;; (define a (with-output-to-string (lambda ()(write x))))
	   (mt-bindir-path #f)
	   (testinfo   (rmt:get-test-info-by-id run-id test-id))
	   (mt_target  (string-intersperse (map cadr keyvals) "/"))
	   (debug-param (append (if (args:get-arg "-debug")  (list "-debug" (args:get-arg "-debug")) '())
				(if (args:get-arg "-logging")(list "-logging") '()))))
				(if (args:get-arg "-logging")(list "-logging") '())
				(if (configf:lookup *configdat* "misc" "profilesw")
				    (list (configf:lookup *configdat* "misc" "profilesw"))
				    '()))))
      ;; (if hosts (set! hosts (string-split hosts)))
      ;; set the megatest to be called on the remote host
      (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest"))
      (set! mt-bindir-path (pathname-directory remote-megatest))
      (if launcher (set! launcher (string-split launcher)))
      ;; set up the run work area for this test
      (if (and (args:get-arg "-preclean") ;; user has requested to preclean for this run
1750
1751
1752
1753
1754
1755
1756
1757


1758
1759
1760
1761
1762
1763
1764
1754
1755
1756
1757
1758
1759
1760

1761
1762
1763
1764
1765
1766
1767
1768
1769







-
+
+







	      ;; NB// Is this still needed? Should be safe to go back to "exit" now?
	      (process-signal (current-process-id) signal/kill)
	      ))
	(alist->env-vars miscprevvals)
	(alist->env-vars testprevvals)
	(alist->env-vars commonprevvals)
	launch-results))
    (change-directory *toppath*)))
    (change-directory *toppath*)
    (thread-sleep! (configf:lookup-number *configdat* "setup" "inter-test-delay" default: 0.0))))

;; recover a test where the top controlling mtest may have died
;;
(define (launch:recover-test run-id test-id)
  ;; this function is called on the test run host via ssh
  ;;
  ;; 1. look at the process from pid