Megatest

Check-in [2278ceb10b]
Login
Overview
Comment:changed mesage output from check for process to go to stderr and use debug:print
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 2278ceb10ba85aa046a062c32573c4811d2fc38e
User & Date: matt on 2020-07-23 00:01:14
Other Links: branch diff | manifest | tags
Context
2020-07-24
17:06
Speculative fixes/defense against couple crashes check-in: 214ac17773 user: mrwellan tags: v1.65, v1.6546
2020-07-23
00:01
changed mesage output from check for process to go to stderr and use debug:print check-in: 2278ceb10b user: matt tags: v1.65
2020-07-22
23:04
Added check for process connected to pid for apparently DEAD tests check-in: d3acaae231 user: matt tags: v1.65
Changes

Modified launch.scm from [52a1e3ae7e] to [ce62ae774a].

941
942
943
944
945
946
947
948
949
950
951
952
953
954
955








956
957
958
959
960
961
962
941
942
943
944
945
946
947








948
949
950
951
952
953
954
955
956
957
958
959
960
961
962







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







		       (let* ((test-name (vector-ref running-test 2))
                 (item-path (vector-ref running-test 11)))
			       	(debug:print 0 *default-log-port* "test " test-name "/" item-path " not completed")
              (if (not (null? tal))
				  (loop (car tal) (cdr tal)))))))))))        
 
(define (launch:is-test-alive host pid)
(if (and host pid (not (equal? host "n/a")))
(let* ((cmd (conc "ssh " host " pstree -A " pid))
      (output (with-input-from-pipe cmd read-lines)))
  (print "cmd: " cmd "\n op: " output )
  (if(eq? (length output) 0)
     #f
     #t))
#t))
  (if (and host pid (not (equal? host "n/a")))
      (let* ((cmd (conc "ssh " host " pstree -A " pid))
	     (output (with-input-from-pipe cmd read-lines)))
	(debug:print 2 *default-log-port* "Running " cmd " received " output)
	(if (eq? (length output) 0)
	   #f
	   #t))
      #t))
 
(define (launch:kill-tests-if-dead run-id)
  (let* ((running-tests (rmt:get-tests-for-run run-id "%" `("RUNNING" "LAUNCHED" "REMOTEHOSTSTART") `() #f #f #f #f #f #f #f #f)))
       (let loop ((running-test (car running-tests))
			     (tal    (cdr running-tests))
			     (kill-cnt 0))
		       (let* ((test-name (vector-ref running-test 2))