Megatest

Changes On Branch 846b99e992aab1b8
Login

Changes In Branch sqlite-trials Through [846b99e992] Excluding Merge-Ins

This is equivalent to a diff from fd82e8252e to 846b99e992

2014-03-27
11:14
Merged sqlite-trials work to v1.55 check-in: 2b3cd8f3ca user: mrwellan tags: v1.55, v1.5516rc2
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
10:05
Speculative fix for the toplevel problem check-in: f8e4667eee user: matt tags: v1.55

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)