Megatest

Check-in [bd18160690]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Fixed bugs in exit handling
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: bd181606907e30ce7d2fb3f8daa1598f1c1a2791
User & Date: mrwellan on 2014-11-19 14:36:58
Other Links: branch diff | manifest | tags
Context
2014-11-20
21:44
full fs access support and megatest.db turned off by default check-in: c8926e3cff user: matt tags: v1.60
2014-11-19
14:36
Fixed bugs in exit handling check-in: bd18160690 user: mrwellan tags: v1.60
2014-11-18
22:29
Fixed couple minor bugs check-in: 4e02f67409 user: matt tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [afd51ef265] to [1e23489cd0]. 

210
211
212
213
214
215
216

































217
218
219
220
221
222
223

210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256







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








(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))
    (if res (cadr res)(if (null? default) #f (car default)))))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "testsuite" )
       (pathname-file *toppath*)))

;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (std-exit-procedure)
  (debug:print-info 0 "starting exit process, finalizing databases.")
  (rmt:print-db-stats)
  (let ((run-ids (hash-table-keys *db-local-sync*)))
    (if (not (null? run-ids))
	(db:multi-db-sync run-ids 'new2old)))
  (if *dbstruct-db* (db:close-all *dbstruct-db*))
  (if (and *megatest-db*
	   (sqlite3:database? *megatest-db*))
      (begin
	(sqlite3:interrupt! *megatest-db*)
	(sqlite3:finalize! *megatest-db* #t)
	(set! *megatest-db* #f)))
  (if *task-db*     (let ((db (cdr *task-db*)))
		      (if (sqlite3:database? db)
			  (begin
			    (sqlite3:interrupt! db)
			    (sqlite3:finalize! db #t)
			    (vector-set! *task-db* 0 #f))))))

(define (std-signal-handler signum)
  (signal-mask! signum)
  (debug:print 0 "ERROR: Received signal " signum " exiting promptly")
  ;; (std-exit-procedure) ;; shouldn't need this since we are exiting and it will be called anyway
  (exit))

(set-signal-handler! signal/int std-signal-handler)
(set-signal-handler! signal/term std-signal-handler)

;;======================================================================
;; Misc utils
;;======================================================================

;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
(define (common:hms-string->seconds tstr)

Modified dashboard.scm from [ea8b1971cf] to [6d6a8350b9]. 

1517
1518
1519
1520
1521
1522
1523
1524

1525
1526
1527
1528
1529
1530
1531
1532

1517
1518
1519
1520
1521
1522
1523

1524

1525
1526
1527
1528
1529
1530
1531







-
+
-








(cond 
 ((args:get-arg "-run")
  (let ((runid (string->number (args:get-arg "-run"))))
    (if runid
	(begin
	  (lambda (x)
	    (on-exit (lambda ()
	    (on-exit std-exit-procedure)
		       (if *dbstruct-local* (db:close-all *dbstruct-local*))))
	    (examine-run *dbstruct-local* runid)))
	(begin
	  (print "ERROR: runid is not a number " (args:get-arg "-run"))
	  (exit 1)))))
 ((args:get-arg "-test") ;; run-id,test-id
  (let* ((dat     (map string->number (string-split (args:get-arg "-test") ",")))
	 (run-id  (car dat))

Modified db.scm from [b24a0c30a3] to [7c7482ed09]. 

176
177
178
179
180
181
182
183

184
185
186
187
188


189
190
191
192
193
194
195

176
177
178
179
180
181
182

183
184
185
186
187

188
189
190
191
192
193
194
195
196







-
+




-
+
+








	      db)
	    (begin
	      (debug:print 0 "ERROR: no such db in non-writable dir " fname)
	      (sqlite3:open-database fname))))))

;; This routine creates the db. It is only called if the db is not already opened
;; 
(define (db:open-rundb dbstruct run-id #!key (attemptnum 0)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
(define (db:open-rundb dbstruct run-id #!key (attemptnum 0)(do-not-open #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((local  (dbr:dbstruct-get-local dbstruct))
	 (rdb    (if local
		     (dbr:dbstruct-get-localdb dbstruct run-id)
		     (dbr:dbstruct-get-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
    (if rdb
    (if (or rdb
	    do-not-open)
	rdb
	(let* ((dbpath       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
	       (dbexists     (file-exists? dbpath))
	       (inmem        (if local #f (db:open-inmem-db)))
	       (refdb        (if local #f (db:open-inmem-db)))
	       (db           (db:lock-create-open dbpath 
						  (lambda (db)

317
318
319
320
321
322
323
















324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356



































357
358
359
360
361
362
363

318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346



























347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388







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






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








	      (db:delay-if-busy rundb)
	      (db:delay-if-busy olddb)
	      (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
		(dbr:dbstruct-set-stime! dbstruct (current-milliseconds))
		num-synced)
	      0)))))

(define (db:close-main dbstruct)
  (let ((maindb (dbr:dbstruct-get-main dbstruct)))
    (if maindb
	(begin
	  (sqlite3:finalize! (db:dbdat-get-db maindb))
	  (dbr:dbstruct-set-main! dbstruct #f)))))

(define (db:close-run-db dbstruct run-id)
  (let ((rdb (db:open-rundb dbstruct run-id do-not-open: #t)))
    (if (and rdb
	     (sqlite3:database? rdb))
	(begin
	  (sqlite3:finalize! rdb)
	  (dbr:dbstruct-set-localdb! dbstruct run-id #f)
	  (dbr:dbstruct-set-inmem! dbstruct #f)))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  ;; finalize main.db
  (db:sync-touched dbstruct 0 force-sync: #t)
  ;;(common:db-block-further-queries)
  ;; (mutex-lock! *db-sync-mutex*) ;; with this perhaps it isn't necessary to use the block-further-queries mechanism?
  (sqlite3:finalize! (db:dbdat-get-db (db:get-db dbstruct #f)))
  (let* ((local (dbr:dbstruct-get-local dbstruct))
	 (rundb (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct))))
    (if local
	(for-each
	 (lambda (dbdat)
	   (let ((db (db:dbdat-get-db dbdat)))
	     (if (sqlite3:database? db)
		 (begin
		   (sqlite3:interrupt! db)
		   (sqlite3:finalize! db #t)))))
	 ;; TODO: Come back to this and rework to delete from hashtable when finalized
	 (hash-table-values (dbr:dbstruct-get-locdbs dbstruct))))
    (thread-sleep! 3)
    (if (and rundb
	     (sqlite3:database? rundb))
	(handle-exceptions
	 exn
	 (begin 
	   (debug:print 0 "WARNING: database files may not have been closed correctly. Consider running -cleanup-db")
	   (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
	   (debug:print 0 " db: " rundb)
	   (print-call-chain (current-error-port))
	   #f)
	 (sqlite3:interrupt! rundb)
	 (sqlite3:finalize! rundb #t))))
  ;; (mutex-unlock! *db-sync-mutex*)

  (db:close-main dbstruct)
  
  (let ((locdbs (dbr:dbstruct-get-locdbs dbstruct)))
    (if (hash-table? locdbs)
	(for-each (lambda (run-id)
		    (db:close-run-db dbstruct run-id))
		  (hash-table-keys locdbs))))

  ;; (let* ((local (dbr:dbstruct-get-local dbstruct))
  ;;        (rundb (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct))))
  ;;   (if local
  ;;       (for-each
  ;;        (lambda (dbdat)
  ;;          (let ((db (db:dbdat-get-db dbdat)))
  ;;            (if (sqlite3:database? db)
  ;;       	 (begin
  ;;       	   (sqlite3:interrupt! db)
  ;;       	   (sqlite3:finalize! db #t)))))
  ;;        ;; TODO: Come back to this and rework to delete from hashtable when finalized
  ;;        (hash-table-values (dbr:dbstruct-get-locdbs dbstruct))))
  ;;   (thread-sleep! 3)
  ;;   (if (and rundb
  ;;            (sqlite3:database? rundb))
  ;;       (handle-exceptions
  ;;        exn
  ;;        (begin 
  ;;          (debug:print 0 "WARNING: database files may not have been closed correctly. Consider running -cleanup-db")
  ;;          (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
  ;;          (debug:print 0 " db: " rundb)
  ;;          (print-call-chain (current-error-port))
  ;;          #f)
  ;;        (sqlite3:interrupt! rundb)
  ;;        (sqlite3:finalize! rundb #t))))
  ;; ;; (mutex-unlock! *db-sync-mutex*)
  )

(define (db:open-inmem-db)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler (make-busy-timeout 3600)))
    (sqlite3:set-busy-handler! db handler)
    (db:initialize-run-id-db db)

Modified megatest.scm from [95c83df933] to [b300543c22]. 

318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354

318
319
320
321
322
323
324























325
326
327
328
329
330
331







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








	   (begin
	     (thread-sleep! 1) ;; wait one second before syncing again
	     (loop)))))
   "Watchdog thread"))

(thread-start! *watchdog*)

(define (std-exit-procedure)
  (rmt:print-db-stats)
  (let ((run-ids (hash-table-keys *db-local-sync*)))
    (if (not (null? run-ids))
	(db:multi-db-sync run-ids 'new2old)))
  ;; (if *dbstruct-db* (db:close-all *dbstruct-db*))
  ;; (if *megatest-db* (begin
  ;;       	      (sqlite3:interrupt! *megatest-db*)
  ;;       	      (sqlite3:finalize! *megatest-db* #t)))
  ;; (if *task-db*     (let ((db (vector-ref *task-db* 0)))
  ;;       	      (sqlite3:interrupt! db)
  ;;       	      (sqlite3:finalize! db #t))))
  )

(define (std-signal-handler signum)
  (signal-mask! signum)
  (debug:print 0 "ERROR: Received signal " signum " exiting promptly")
  (std-exit-procedure)
  (exit))

(set-signal-handler! signal/int std-signal-handler)
(set-signal-handler! signal/term std-signal-handler)

(if (args:get-arg "-log")
    (let ((oup (open-output-file (args:get-arg "-log"))))
      (debug:print-info 0 "Sending log output to " (args:get-arg "-log"))
      (current-error-port oup)
      (current-output-port oup)))

(if (or (args:get-arg "-h")

409
410
411
412
413
414
415
416

417
418
419
420
421
422
423

386
387
388
389
390
391
392

393
394
395
396
397
398
399
400







-
+








(if (args:get-arg "-itempatt")
    (let ((newval (conc (args:get-arg "-testpatt") "/" (args:get-arg "-itempatt"))))
      (debug:print 0 "WARNING: -itempatt has been deprecated, please use -testpatt testpatt/itempatt method, new testpatt is "newval)
      (hash-table-set! args:arg-hash "-testpatt" newval)
      (hash-table-delete! args:arg-hash "-itempatt")))

;; (on-exit std-exit-procedure)
(on-exit std-exit-procedure)

;;======================================================================
;; Misc general calls
;;======================================================================

(if (args:get-arg "-env2file")
    (begin

Modified tasks.scm from [5a72285f95] to [a0ed950b28]. 

352
353
354
355
356
357
358
359

360
361
362
363
364
365
366

352
353
354
355
356
357
358

359
360
361
362
363
364
365
366







-
+








(define (tasks:start-and-wait-for-server tdbdat run-id delay-max-tries)
  ;; ensure a server is running for this run
  (let loop ((server-dat (tasks:get-server (db:delay-if-busy tdbdat) run-id))
	     (delay-time 0))
      (if (and (not server-dat)
	       (< delay-time delay-max-tries))
	  (begin
	    (if (common:low-noise-print 60 run-id)(debug:print 0 "Try starting server for run-id " run-id))
	    (if (common:low-noise-print 60 "tasks:start-and-wait-for-server" run-id)(debug:print 0 "Try starting server for run-id " run-id))
	    (server:kind-run run-id)
	    (thread-sleep! (min delay-time 5))
	    (loop (tasks:get-server (db:delay-if-busy tdbdat) run-id)(+ delay-time 1))))))

(define (tasks:get-all-servers mdb)
  (let ((res '()))
    (sqlite3:for-each-row

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