Megatest

Check-in [1daca50091]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Fixed missing host/uname data. Streamlined data updates from running test a little
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: 1daca5009176e95957d24d9b0e8feb007a94d18f
User & Date: matt on 2013-08-11 21:44:07
Other Links: branch diff | manifest | tags
Context
2013-08-12
00:51
Fixed locking on rollup bug by writing simple locking queue explictly for the needed behavior check-in: 7180157463 user: matt tags: v1.55
2013-08-11
21:44
Fixed missing host/uname data. Streamlined data updates from running test a little check-in: 1daca50091 user: matt tags: v1.55
19:38
Added howto section to the manual check-in: a10660b42e user: mrwellan tags: v1.55
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard-tests.scm from [7e70dcfc3e] to [dbec7eed15].

︙
295
296
297
298
299
300
301
302

303
304
305
306
307
308
309

295
296
297
298
299
300
301

302
303
304
305
306
307
308
309








-
+








	 (db-path       (conc *toppath* "/megatest.db"))
	 (db-mod-time   0) ;; (file-modification-time db-path))
	 (last-update   0) ;; (current-seconds))
	 (request-update #t)
	 (db             #f))
    (if (not testdat)
	(begin
	  (debug:print 0 "ERROR: No test data found for test " test-id ", exiting")
	  (debug:print 2 "ERROR: No test data found for test " test-id ", exiting")
	  (exit 1))
	(let* ((run-id        (if testdat (db:test-get-run_id testdat) #f))
	       (keydat        (if testdat (open-run-close db:get-key-val-pairs #f run-id) #f))
	       (rundat        (if testdat (open-run-close db:get-run-info #f run-id) #f))
	       (runname       (if testdat (db:get-value-by-header (db:get-row rundat)
								  (db:get-header rundat)
								  "runname") #f))
︙

Modified db.scm from [8d37c78057] to [3f7c697afc].

︙
1103
1104
1105
1106
1107
1108
1109
1110

1111
1112
1113
1114
1115
1116
1117

1103
1104
1105
1106
1107
1108
1109

1110
1111
1112
1113
1114
1115
1116
1117








-
+








(define (cdb:tests-update-cpuload-diskfree serverdat test-id cpuload diskfree)
  (cdb:client-call serverdat 'update-cpuload-diskfree #t *default-numtries* cpuload diskfree test-id))

(define (cdb:tests-update-run-duration serverdat test-id minutes)
  (cdb:client-call serverdat 'update-run-duration #t *default-numtries* minutes test-id))

(define (cdb:tests-update-uname-host serverdat test-id uname hostname)
  (cdb:client-call serverdat 'update-uname-host #t *default-numtries* test-id uname hostname))
  (cdb:client-call serverdat 'update-uname-host #t *default-numtries* uname hostname test-id))

;; speed up for common cases with a little logic
(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
  (cond
   ((and newstate newstatus newcomment)
    (sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id))
   ((and newstate newstatus)
︙

Modified launch.scm from [093abc1258] to [870df0aae4].

︙
133
134
135
136
137
138
139
140

141
142
143
144
145
146
147

133
134
135
136
137
138
139

140
141
142
143
144
145
146
147








-
+








	  (set-run-config-vars run-id keyvals target) ;; (db:get-target db run-id))
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
	  (set-megatest-env-vars run-id)
	  (set-item-env-vars itemdat)
	  (save-environment-as-files "megatest")
	  ;; open-run-close not needed for test-set-meta-info
	  (tests:set-meta-info #f test-id run-id test-name itemdat 0 work-area)
	  (tests:set-full-meta-info #f test-id run-id 0 work-area)
	  (tests:test-set-status! test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f)
	  (if (args:get-arg "-xterm")
	      (set! fullrunscript "xterm")
	      (if (and fullrunscript (not (file-execute-access? fullrunscript)))
		  (system (conc "chmod ug+x " fullrunscript))))
	  ;; We are about to actually kick off the test
	  ;; so this is a good place to remove the records for
︙
168
169
170
171
172
173
174
175

176
177
178
179
180
181
182

168
169
170
171
172
173
174

175
176
177
178
179
180
181
182








-
+








					  (vector-set! exit-info 0 pid)
					  (vector-set! exit-info 1 exit-status)
					  (vector-set! exit-info 2 exit-code)
					  (set! rollup-status exit-code) 
					  (mutex-unlock! m)
					  (if (eq? pid-val 0)
					      (begin
						(thread-sleep! 2)
						(thread-sleep! 1)
						(loop (+ i 1)))
					      )))))
				 ;; then, if runscript ran ok (or did not get called)
				 ;; do all the ezsteps (if any)
				 (if ezsteps
				     (let* ((testconfig (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here?
					    (ezstepslst (hash-table-ref/default testconfig "ezsteps" '())))
︙
221
222
223
224
225
226
227
228

229
230
231
232
233
234
235

221
222
223
224
225
226
227

228
229
230
231
232
233
234
235








-
+








								   (mutex-lock! m)
								   (vector-set! exit-info 0 pid)
								   (vector-set! exit-info 1 exit-status)
								   (vector-set! exit-info 2 exit-code)
								   (mutex-unlock! m)
								   (if (eq? pid-val 0)
								       (begin
									 (thread-sleep! 2)
									 (thread-sleep! 1)
									 (processloop (+ i 1))))
								   ))
                                                     (let ((exinfo (vector-ref exit-info 2))
                                                           (logfna (if logpro-used (conc stepname ".html") "")))
						       ;; testing if procedures called in a remote call cause problems (ans: no or so I suspect)
						       (db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna work-area: work-area))
						     (if logpro-used
︙
273
274
275
276
277
278
279

280
281
282
283
284
285
286
287
288
289
290
291

292
293
294
295
296
297
298

273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
299








+











-
+








					(calc-minutes  (lambda ()
							 (inexact->exact 
							  (round 
							   (- 
							    (current-seconds) 
							    start-seconds)))))
					(kill-tries 0))
				   (tests:set-full-meta-info #f test-id run-id (calc-minutes) work-area)
				   (let loop ((minutes   (calc-minutes)))
				     (begin
				       (set! kill-job? (or (test-get-kill-request test-id) ;; run-id test-name itemdat))
							   (and runtlim (let* ((run-seconds   (- (current-seconds) start-seconds))
									       (time-exceeded (> run-seconds runtlim)))
									  (if time-exceeded
									      (begin
										(debug:print-info 0 "KILLING TEST DUE TO TIME LIMIT EXCEEDED! Runtime=" run-seconds " seconds, limit=" runtlim)
										#t)
									      #f)))))
				       ;; open-run-close not needed for test-set-meta-info
				       (tests:set-meta-info #f test-id run-id test-name itemdat minutes work-area)
				       (tests:set-partial-meta-info #f test-id run-id minutes work-area)
				       (if kill-job? 
					   (begin
					     (mutex-lock! m)
					     ;; NOTE: The pid can change as different steps are run. Do we need handshaking between this
					     ;;       section and the runit section? Or add a loop that tries three times with a 1/4 second
					     ;;       between tries?
					     (let* ((pid (vector-ref exit-info 0)))
︙

Modified tests.scm from [3fc8cabe45] to [5109c208ba].

︙
677
678
679
680
681
682
683
684

685
686
687
688
689
690
691
692
693
694


695
696
697


698
699
700

701
702

703
704
705

706
707

708
709
710
711















712
713
714
715

716
717
718
719
720
721
722

677
678
679
680
681
682
683

684
685
686
687







688
689



690
691



692


693
694


695
696

697




698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715

716
717
718
719
720
721
722
723








-
+



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

-
-
+

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



-
+








	 (lambda (count)
	   (set! res count))
	 tdb
	 "SELECT count(id) FROM test_rundat;")
	res))
  0)

(define (tests:update-central-meta-info test-id cpuload diskfree minutes num-records uname hostname)
(define (tests:update-central-meta-info test-id cpuload diskfree minutes uname hostname)
  ;; This is a good candidate for threading the requests to enable
  ;; transactionized write at the server
  (cdb:tests-update-cpuload-diskfree *runremote* test-id cpuload diskfree)
  ;; (let ((db (open-db)))
    ;; (sqlite3:execute db "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;"
    ;;     	     cpuload
    ;;     	     diskfree
    ;;     	     test-id)
    (if minutes 
	(cdb:tests-update-run-duration *runremote* test-id minutes))
  (if minutes 
      (cdb:tests-update-run-duration *runremote* test-id minutes))
	;; (sqlite3:execute db "UPDATE tests SET run_duration=? WHERE id=?;" minutes test-id))
    (if (eq? num-records 0)
	(cdb:tests-update-uname-host *runremote* test-id uname hostname))
  (if (and uname hostname)
      (cdb:tests-update-uname-host *runremote* test-id uname hostname)))
	;;(sqlite3:execute db "UPDATE tests SET uname=?,host=? WHERE id=?;" uname hostname test-id))
    ;;(sqlite3:finalize! db))
    )
  
  
(define (tests:set-meta-info db test-id run-id testname itemdat minutes work-area)
(define (tests:set-full-meta-info db test-id run-id minutes work-area)
  ;; DOES cdb:remote-run under the hood!
  (let* ((tdb         (db:open-test-db-by-test-id db test-id work-area: work-area))
	 (num-records (test:tdb-get-rundat-count tdb))
  (let* ((num-records 0) ;; (test:tdb-get-rundat-count tdb))
	 (cpuload  (get-cpu-load))
	 (diskfree (get-df (current-directory))))
	 (diskfree (get-df (current-directory)))
    (if (eq? (modulo num-records 10) 0) ;; every ten records update central
	(let ((uname    (get-uname "-srvpio"))
	      (hostname (get-host-name)))
	  (tests:update-central-meta-info test-id cpuload diskfree minutes num-records uname hostname)))
	 (uname    (get-uname "-srvpio"))
	 (hostname (get-host-name)))
    (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes)
    (tests:update-central-meta-info test-id cpuload diskfree minutes uname hostname)))
	  
(define (tests:set-partial-meta-info db test-id run-id minutes work-area)
  ;; DOES cdb:remote-run under the hood!
  (let* ((cpuload  (get-cpu-load))
	 (diskfree (get-df (current-directory))))
    (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes)
    ;; Update central with uname and hostname = #f
    (tests:update-central-meta-info test-id cpuload diskfree minutes #f #f)))
	 
(define (tests:update-testdat-meta-info db test-id work-area cpuload diskfree minutes)
  (let ((tdb         (db:open-test-db-by-test-id db test-id work-area: work-area)))
    (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);"
		     cpuload diskfree minutes)
    (sqlite3:finalize! tdb)))
	  
 
;;======================================================================
;; A R C H I V I N G
;;======================================================================

(define (test:archive db test-id)
  #f)
︙

tests/installall/config/megatest.config.dat became a regular file with contents [736a5da885].

tests/installall/config/runconfigs.config.dat became a regular file with contents [3b8f260acb].

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