Megatest

Check-in [846b99e992]
Login
Overview
Comment:Trial work on exception handling for sqlite issues
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | sqlite-trials
Files: files | file ages | folders
SHA1: 846b99e992aab1b8e971fa34eec6f58faba6a4e3
User & Date: mrwellan on 2014-03-26 22:17:20
Other Links: branch diff | manifest | tags
Context
2014-03-27
11:13
Tweaked timeouts and added more agressive exception handling to sqlite3 calls. Also cd to MT_RUN_AREA_HOME in dashboard if run in a test enviroment Closed-Leaf check-in: 158702d7aa user: mrwellan tags: sqlite-trials
2014-03-26
22:17
Trial work on exception handling for sqlite issues check-in: 846b99e992 user: mrwellan tags: sqlite-trials
2014-03-25
12:30
Bumped version. check-in: fd82e8252e user: icfadm tags: v1.55, v1.5516rc1
Changes

Modified db.scm from [820999b8e9] to [fc53c2f8f2].

71
72
73
74
75
76
77
78

79
80
81
82
83
84
85
71
72
73
74
75
76
77

78
79
80
81
82
83
84
85







-
+







	    (exit))))
  (let* ((dbpath    (conc *toppath* "/megatest.db")) ;; fname)
	 (dbexists  (file-exists? dbpath))
	 (write-access (file-write-access? dbpath))
	 (db        (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					   (string->number (args:get-arg "-override-timeout"))
					   136000)))) ;; 136000))) ;; 136000 = 2.2 minutes
					   30)))) ;; 136000))) ;; 136000 = 2.2 minutes
    (if (and dbexists
	     (not write-access))
	(set! *db-write-access* write-access)) ;; only unset so other db's also can use this control
    (debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv))
    (if write-access (sqlite3:set-busy-handler! db handler))
    (if (not dbexists)
	(db:initialize db))
108
109
110
111
112
113
114
115

116
117
118
119
120

121
122
123
124
125
126
127
108
109
110
111
112
113
114

115
116
117
118
119

120
121
122
123
124
125
126
127







-
+




-
+







  (handle-exceptions
   exn
   (begin
     (debug:print 0 "EXCEPTION: database probably overloaded or unreadable.")
     (debug:print 0 "  " ((condition-property-accessor 'exn 'message) exn))
     (print-call-chain)
     (thread-sleep! (random 120))
     (debug:print-info 0 "trying db call one more time....")
     (debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (current-host-name) " to clean up")
     (apply open-run-close-no-exception-handling proc idb params))
   (apply open-run-close-no-exception-handling proc idb params)))

;; (define open-run-close open-run-close-exception-handling)
(define open-run-close open-run-close-no-exception-handling)
(define open-run-close open-run-close-exception-handling)

(define *global-delta* 0)
(define *last-global-delta-printed* 0)

(define (open-run-close-measure  proc idb . params)
  (debug:print-info 11 "open-run-close-measure START, idb=" idb ", params=" params)
  (let* ((start-ms (current-milliseconds))
269
270
271
272
273
274
275

276

277
278
279
280
281
282
283
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284







+
-
+







	   (debug:print 2 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
			((condition-property-accessor 'exn 'message) exn))
	   (set! db (sqlite3:open-database ":memory:"))) ;; open an in-memory db to allow readonly access 
	 (set! db (sqlite3:open-database dbpath)))
	(if *db-write-access* (sqlite3:set-busy-handler! db handler))
	(if (not dbexists)
	    (begin
	      ;; Why use FULL here? This data is not that critical
	      (sqlite3:execute db "PRAGMA synchronous = FULL;")
	      ;; (sqlite3:execute db "PRAGMA synchronous = FULL;")
	      (debug:print-info 11 "Initialized test database " dbpath)
	      (db:testdb-initialize db)))
	;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	(debug:print-info 11 "open-test-db END (sucessful)" work-area)
	;; now let's test that everything is correct
	(handle-exceptions
	 exn

Modified runs.scm from [16fd05bb4c] to [d043a7c00f].

459
460
461
462
463
464
465


466
467
468
469





470
471
472
473
474
475
476
477

478
479
480
481
482
483
484
459
460
461
462
463
464
465
466
467




468
469
470
471
472
473
474
475
476
477
478
479

480
481
482
483
484
485
486
487







+
+
-
-
-
-
+
+
+
+
+







-
+







             ;; (notinqueue (filter (lambda (x)
             ;;    		   (not (member x allinqueue)))
             ;;    		 prereqstrs))
	     (give-up    #f))

	;; We can get here when a prereq has not been run due to *it* having a prereq that failed.
	;; We need to use this to dequeue this item as CANNOTRUN
	;; 
	(if (member testmode '(toplevel))
	(for-each (lambda (prereq)
		    (if (eq? (hash-table-ref/default test-registry prereq 'justfine) 'CANNOTRUN)
			(set! give-up #t)))
		  prereqstrs)
	    (for-each (lambda (prereq)
			(if (eq? (hash-table-ref/default test-registry prereq 'justfine) 'CANNOTRUN)
			    (set! give-up #t)))
		      prereqstrs))

	(if (and give-up
		 (not (and (null? tal)(null? reg))))
	    (let ((trimmed-tal (mt:discard-blocked-tests run-id hed tal test-records))
		  (trimmed-reg (mt:discard-blocked-tests run-id hed reg test-records)))
	      (debug:print 1 "WARNING: test " hed " has discarded prerequisites, removing it from the queue")

	      (let ((test-id (cdb:remote-run db:get-test-id-cached #f run-id hed "")))
		(mt:test-set-state-status-by-id test-id "DEQUED" "PREQ_FAIL" "Failed to run due to failed prerequisites"))
		(mt:test-set-state-status-by-id test-id "DEQUEUED" "PREQ_FAIL" "Failed to run due to failed prerequisites"))
	      
	      (if (and (null? trimmed-tal)
		       (null? trimmed-reg))
		  #f
		  (list (runs:queue-next-hed trimmed-tal trimmed-reg reglen regfull)
			(runs:queue-next-tal trimmed-tal trimmed-reg reglen regfull)
			(runs:queue-next-reg trimmed-tal trimmed-reg reglen regfull)