Megatest

Check-in [bbdb404874]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:wip, compiles
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.90-proper-interface-lists
Files: files | file ages | folders
SHA1: bbdb4048748938c9a7f290c16a4674e5e9328e6d
User & Date: mrwellan on 2024-02-12 14:31:25
Other Links: branch diff | manifest | tags
Context
2024-02-12
15:42
repl runs check-in: b969852101 user: mrwellan tags: v1.90-proper-interface-lists
14:31
wip, compiles check-in: bbdb404874 user: mrwellan tags: v1.90-proper-interface-lists
13:45
wip check-in: e0be4c40b4 user: mrwellan tags: v1.90-proper-interface-lists
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified commonmod.scm from [383f62c6d4] to [26ca4d0bed].

︙
276
277
278
279
280
281
282

283











284
285
286
287
288
289
290

276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301








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








	 common:clear-caches
	 db:mintest-get-event_time
	 *test-meta-updated*
	 tests:testqueue-set-item_path!
	 tests:testqueue-set-itemdat!
	 make-tests:testqueue

	 megatest-fossil-hash
)

	 common:steps-can-proceed-given-status-sym
	 status-sym->string
	 common:worse-status-sym
	 common:logpro-exit-code->status-sym

	 save-environment-as-files
	 assoc/default
	 common:read-encoded-string

	 )
	
(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
	  ports
︙

Modified configfmod.scm from [deed360501] to [8facfee8f8].

︙
39
40
41
42
43
44
45


46
47
48
49
50
51
52

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54








+
+








	 configf:read-alist
	 configf:config->alist
	 configf:alist->config
	 configf:set-section-var

	 find-and-read-config
	 common:args-get-target
	 configf:eval-string-in-environment

	)

(import scheme
        chicken
	extras
	files
	matchable
︙

Modified dbmod.scm from [6473e71a88] to [4ab5fd7962].

︙
165
166
167
168
169
170
171

172
173
174
175
176
177
178

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179








+








	 db:get-header
	 db:get-rows
	 db:get-changed-run-ids

	 db:set-sync
	 db:setup

	 db:logpro-dat->csv
	 )
	
(import scheme)
	
(cond-expand
 (chicken-4
  (import chicken
︙

Modified launchmod.scm from [85fd072687] to [a0b277c06f].

︙
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

43
44
45
46
47
48
49

50
51
52
53
54
55
56








-








(declare (uses runsmod))
(declare (uses fsmod))

(use srfi-69)

(module launchmod
	(
	rmt:find-and-mark-incomplete
	)

(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
︙
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078

978
979
980
981
982
983
984






















































































985
986
987
988
989
990
991








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








		     #f)))
    ;; now wait on that process if all is correct
    ;; periodically update the db with runtime
    ;; when the process exits look at the db, if still RUNNING after 10 seconds set
    ;; state/status appropriately
    (process-wait pid)))

;;======================================================================
;; Maintenance
;;======================================================================

(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
  (let* ((cfg-deadtime             (configf:lookup-number *configdat* "setup" "deadtime"))
	 (test-stats-update-period (configf:lookup-number *configdat* "setup" "test-stats-update-period")))
   (rmt:find-and-mark-incomplete-engine run-id ovr-deadtime cfg-deadtime test-stats-update-period)
   ;;call end of eud of run detection for posthook
   (launch:end-of-run-check run-id)))

;;  select end_time-now from
;;      (select testname,item_path,event_time+run_duration as
;;                          end_time,strftime('%s','now') as now from tests where state in
;;      ('RUNNING','REMOTEHOSTSTART','LAUNCHED'));
;;
;; NOT EASY TO MIGRATE TO db{file,mod}
;;
(define (rmt:find-and-mark-incomplete-engine run-id ovr-deadtime cfg-deadtime test-stats-update-period)
  (let* ((incompleted '())
	 (oldlaunched '())
	 (toplevels   '())
          ;; The default running-deadtime is 720 seconds = 12 minutes.
          ;; "(running-deadtime-default (+ server-start-allowance (* 2 launch-monitor-period)))" = 200 + (2 * (200 + 30 + 30))
         (deadtime-trim (or ovr-deadtime cfg-deadtime))
         (server-start-allowance 200)
         (server-overloaded-budget 200)
         (launch-monitor-off-time (or test-stats-update-period 30))
         (launch-monitor-on-time-budget 30)
         (launch-monitor-period (+ launch-monitor-off-time launch-monitor-on-time-budget server-overloaded-budget))
         (remotehoststart-deadtime-default (+ server-start-allowance server-overloaded-budget 30))
         (remotehoststart-deadtime (or deadtime-trim remotehoststart-deadtime-default))
         (running-deadtime-default (+ server-start-allowance (* 2 launch-monitor-period)))
         (running-deadtime (or deadtime-trim running-deadtime-default))) ;; two minutes (30 seconds between updates, this leaves 3x grace period)

    (debug:print-info 4  *default-log-port* "running-deadtime = " running-deadtime)
    (debug:print-info 4  *default-log-port* "deadtime-trim = " deadtime-trim)

    (let* ((dat (rmt:get-toplevels-and-incompletes run-id running-deadtime remotehoststart-deadtime)))
      (set! oldlaunched (list-ref dat 1))
      (set! toplevels   (list-ref dat 2))
      (set! incompleted (list-ref dat 0)))

    (debug:print-info 18 *default-log-port* "Found " (length oldlaunched) " old LAUNCHED items, "
		      (length toplevels) " old LAUNCHED toplevel tests and "
		      (length incompleted) " tests marked RUNNING but apparently dead.")
  
    ;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
    ;;
    ;; (db:delay-if-busy dbdat)
    (let* ((min-incompleted-ids (map car incompleted)) ;; do 'em all
	   (all-ids             (append min-incompleted-ids (map car oldlaunched))))
      (if (> (length all-ids) 0)
	  (begin
	    ;; (launch:is-test-alive "localhost" 435)
	    (debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ")
			 " as DEAD")
	    (for-each
             (lambda (test-id)
               (let* ((tinfo   (rmt:get-test-info-by-id run-id test-id))
		      (run-dir (db:test-get-rundir     tinfo))
		      (host    (db:test-get-host       tinfo))
		      (pid     (db:test-get-process_id tinfo))
		      (result (rmt:get-status-from-final-status-file run-dir)))
		 (if (and (list? result) (> (length result) 1) (equal? "PASS" (cadr result)) (equal? "COMPLETED" (car result))) 
		     (begin
		       (debug:print 0 *default-log-port* "INFO: test " test-id " actually passed, so marking PASS not DEAD")
		       (rmt:set-state-status-and-roll-up-items
			run-id test-id 'foo "COMPLETED" "PASS"
			"Test stopped responding but it has PASSED; marking it PASS in the DB."))
		     (let ((is-alive (and (not (eq? pid 0))  ;; 0 is default in re-used field "attemptnum" where pid stored.
					  (commonmod:is-test-alive host pid))))
		       (if is-alive
			   (debug:print 0 *default-log-port* "INFO: test " test-id " on host " host
					" has a process on pid " pid ", NOT setting to DEAD.")
			   (begin
			     (debug:print 0 *default-log-port* "INFO: test " test-id
					  " final state/status is not COMPLETED/PASS. It is " result)
			     (rmt:set-state-status-and-roll-up-items
			      run-id test-id 'foo "COMPLETED" "DEAD"
			      "Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead.")))))))
	     ;; call end of eud of run detection for posthook - from merge, is it needed?
	     ;; (launch:end-of-run-check run-id)
	     all-ids)
	    )))))


;; TODO: deprecate me in favor of ezsteps.scm
;;
(define (ezsteps:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat)
  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
	 (stepinfo       (cadr ezstep))
	;; (let ((info (cadr ezstep)))
︙

Modified processmod.scm from [42996e8ab1] to [1199556817].

︙
27
28
29
30
31
32
33


34
35
36
37
38
39
40

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42








+
+








(module processmod
	(
	 process:cmd-run->list
	 process:alive?
	 run-n-wait
	 process:cmd-run-with-stderr-and-exitcode->list

	 process:alive-on-host?
	 process:get-sub-pids
	 )

(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
︙

Modified rmtmod.scm from [5bfa5082f0] to [34cdc62311].

︙
125
126
127
128
129
130
131












132
133
134
135
136
137
138

125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150








+
+
+
+
+
+
+
+
+
+
+
+








	 rmt:tasks-set-state-given-param-key
	 rmt:register-run
	 rmt:get-count-tests-running-in-jobgroup
	 rmt:get-count-tests-running-for-run-id
	 
	 rmt:test-set-state-status-by-id
	 mt:test-set-state-status-by-id

	 rmt:get-status-from-final-status-file
	 rmt:get-toplevels-and-incompletes 

	 rmt:test-set-log!
	 rmt:teststep-set-status!

	 rmt:delete-steps-for-test!
	 rmt:test-set-state-status
	 rmt:get-test-state-status-by-id
	 rmt:test-set-top-process-pid

	 )
	
	
(import scheme
	chicken
	data-structures
	regex
︙

Modified runsmod.scm from [135fde13aa] to [2e2fa19e43].

︙
43
44
45
46
47
48
49








50
51
52
53
54
55
56

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64








+
+
+
+
+
+
+
+








(declare (uses archivemod))
(declare (uses fsmod))

(use srfi-69)

(module runsmod
	(
	 rmt:find-and-mark-incomplete
	 launch:setup
	 launch:end-of-run-check
	 launch:test-copy

	 set-item-env-vars
	 runs:set-megatest-env-vars
	 full-runconfigs-read
	 )

(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
︙
4539
4540
4541
4542
4543
4544
4545
4546



4547























































































4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557

4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643









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

		(if (member (symbol->string archive-command) '("save-remove"))
                    (begin 
                     (debug:print-info 0 *default-log-port* "remove testdat")
		    (runs:remove-test-directory test-dat 'archive-remove)))))
	    (hash-table-ref test-groups test-base)))))
       (hash-table-keys disk-groups))
    #t))

;;======================================================================
;; Maintenance
;;======================================================================
)

(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
  (let* ((cfg-deadtime             (configf:lookup-number *configdat* "setup" "deadtime"))
	 (test-stats-update-period (configf:lookup-number *configdat* "setup" "test-stats-update-period")))
   (rmt:find-and-mark-incomplete-engine run-id ovr-deadtime cfg-deadtime test-stats-update-period)
   ;;call end of eud of run detection for posthook
   (launch:end-of-run-check run-id)))

;;  select end_time-now from
;;      (select testname,item_path,event_time+run_duration as
;;                          end_time,strftime('%s','now') as now from tests where state in
;;      ('RUNNING','REMOTEHOSTSTART','LAUNCHED'));
;;
;; NOT EASY TO MIGRATE TO db{file,mod}
;;
(define (rmt:find-and-mark-incomplete-engine run-id ovr-deadtime cfg-deadtime test-stats-update-period)
  (let* ((incompleted '())
	 (oldlaunched '())
	 (toplevels   '())
          ;; The default running-deadtime is 720 seconds = 12 minutes.
          ;; "(running-deadtime-default (+ server-start-allowance (* 2 launch-monitor-period)))" = 200 + (2 * (200 + 30 + 30))
         (deadtime-trim (or ovr-deadtime cfg-deadtime))
         (server-start-allowance 200)
         (server-overloaded-budget 200)
         (launch-monitor-off-time (or test-stats-update-period 30))
         (launch-monitor-on-time-budget 30)
         (launch-monitor-period (+ launch-monitor-off-time launch-monitor-on-time-budget server-overloaded-budget))
         (remotehoststart-deadtime-default (+ server-start-allowance server-overloaded-budget 30))
         (remotehoststart-deadtime (or deadtime-trim remotehoststart-deadtime-default))
         (running-deadtime-default (+ server-start-allowance (* 2 launch-monitor-period)))
         (running-deadtime (or deadtime-trim running-deadtime-default))) ;; two minutes (30 seconds between updates, this leaves 3x grace period)

    (debug:print-info 4  *default-log-port* "running-deadtime = " running-deadtime)
    (debug:print-info 4  *default-log-port* "deadtime-trim = " deadtime-trim)

    (let* ((dat (rmt:get-toplevels-and-incompletes run-id running-deadtime remotehoststart-deadtime)))
      (set! oldlaunched (list-ref dat 1))
      (set! toplevels   (list-ref dat 2))
      (set! incompleted (list-ref dat 0)))

    (debug:print-info 18 *default-log-port* "Found " (length oldlaunched) " old LAUNCHED items, "
		      (length toplevels) " old LAUNCHED toplevel tests and "
		      (length incompleted) " tests marked RUNNING but apparently dead.")
  
    ;; These are defunct tests, do not do all the overhead of set-state-status. Force them to INCOMPLETE.
    ;;
    ;; (db:delay-if-busy dbdat)
    (let* ((min-incompleted-ids (map car incompleted)) ;; do 'em all
	   (all-ids             (append min-incompleted-ids (map car oldlaunched))))
      (if (> (length all-ids) 0)
	  (begin
	    ;; (launch:is-test-alive "localhost" 435)
	    (debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ")
			 " as DEAD")
	    (for-each
             (lambda (test-id)
               (let* ((tinfo   (rmt:get-test-info-by-id run-id test-id))
		      (run-dir (db:test-get-rundir     tinfo))
		      (host    (db:test-get-host       tinfo))
		      (pid     (db:test-get-process_id tinfo))
		      (result (rmt:get-status-from-final-status-file run-dir)))
		 (if (and (list? result) (> (length result) 1) (equal? "PASS" (cadr result)) (equal? "COMPLETED" (car result))) 
		     (begin
		       (debug:print 0 *default-log-port* "INFO: test " test-id " actually passed, so marking PASS not DEAD")
		       (rmt:set-state-status-and-roll-up-items
			run-id test-id 'foo "COMPLETED" "PASS"
			"Test stopped responding but it has PASSED; marking it PASS in the DB."))
		     (let ((is-alive (and (not (eq? pid 0))  ;; 0 is default in re-used field "attemptnum" where pid stored.
					  (commonmod:is-test-alive host pid))))
		       (if is-alive
			   (debug:print 0 *default-log-port* "INFO: test " test-id " on host " host
					" has a process on pid " pid ", NOT setting to DEAD.")
			   (begin
			     (debug:print 0 *default-log-port* "INFO: test " test-id
					  " final state/status is not COMPLETED/PASS. It is " result)
			     (rmt:set-state-status-and-roll-up-items
			      run-id test-id 'foo "COMPLETED" "DEAD"
			      "Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead.")))))))
	     ;; call end of eud of run detection for posthook - from merge, is it needed?
	     ;; (launch:end-of-run-check run-id)
	     all-ids)
	    )))))



)

Modified subrunmod.scm from [0a6ed5a468] to [f63d1179cd].

︙
45
46
47
48
49
50
51


52
53
54
55
56
57
58

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60








+
+








	(
	 subrun:set-state-status
	 subrun:kill-subrun
	 subrun:get-log-path
	 subrun:remove-subrun
	 subrun:subrun-removed?
	 subrun:subrun-test-initialized?
	 subrun:launch-cmd
	 subrun:initialize-toprun-test
	 )

(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
︙

Modified tasksmod.scm from [4185a9e4a7] to [1d99e1d940].

︙
46
47
48
49
50
51
52


53
54
55
56
57
58
59

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61








+
+








	 common:simple-unlock
	 common:simple-lock
	 tests:test-set-status!
	 common:get-launcher
	 tasks:kill-runner
	 tests:get-testconfig
	 tests:get-waitons

	 tests:get-test-path-from-environment

	 )

(import scheme)
(cond-expand
 (chicken-4
︙

Modified testsmod.scm from [9eb37a6a8e] to [70de32f7f8].

︙
42
43
44
45
46
47
48




49
50
51
52
53
54
55

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59








+
+
+
+









(module testsmod
	(
	 tests:summarize-items
	 tests:filter-non-runnable
	 tests:sort-by-priority-and-waiton

	 tests:summarize-test
	 tests:save-final-status
	 tests:update-central-meta-info
	 tests:set-full-meta-info
	 )

(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
︙

This page was generated in about 0.148s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00