Megatest

Check-in [c0aa0a3942]
Login
Overview
Comment:Fix for the dreaded sync bug
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: c0aa0a3942a2b4bdfcff0c3d369e79eb9e94e13a
User & Date: mrwellan on 2014-11-13 17:33:27
Other Links: branch diff | manifest | tags
Context
2014-11-13
18:06
Correctly qualified the check of the connection - was erroring out sometimes check-in: 9b2b3866ab user: mrwellan tags: v1.60
17:33
Fix for the dreaded sync bug check-in: c0aa0a3942 user: mrwellan tags: v1.60
10:12
typo check-in: 9846adb7c9 user: mrwellan tags: v1.60
Changes

Modified db.scm from [fe50e31547] to [b47bb467de].

79
80
81
82
83
84
85

86


87
88
89
90

91
92
93
94
95
96
97
79
80
81
82
83
84
85
86

87
88
89
90
91

92
93
94
95
96
97
98
99







+
-
+
+



-
+







	(dbr:dbstruct-set-inuse! dbstruct #f)
	(mutex-unlock! *rundb-mutex*))))

;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
  (let* ((dbdat (if (vector? dbstruct)
  (let* ((dbdat (db:get-db dbstruct run-id))
		    (db:get-db dbstruct run-id)
		    dbstruct)) ;; cheat, allow for passing in a dbdat
	 (db    (db:dbdat-get-db dbdat)))
    (db:delay-if-busy dbdat)
    (let ((res (apply proc db params)))
      (db:done-with dbstruct run-id r/w)
      (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
      res)))

;;======================================================================
;; K E E P   F I L E D B   I N   dbstruct
;;======================================================================

;; (define (db:get-filedb dbstruct run-id)
413
414
415
416
417
418
419


420
421
422
423
424
425
426
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430







+
+







	   '("iterated"       #f)
	   '("avg_runtime"    #f)
	   '("avg_disk"       #f)
	   '("tags"           #f)
	   '("jobgroup"       #f)))))
    
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;; db's are dbdat's
;;
(define (db:sync-tables tbls fromdb todb . slave-dbs)
  (mutex-lock! *db-sync-mutex*)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
     (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
587
588
589
590
591
592
593
594
595


596
597
598


599
600
601
602
603
604
605
591
592
593
594
595
596
597


598
599
600


601
602
603
604
605
606
607
608
609







-
-
+
+

-
-
+
+








    ;; now ensure all newdb data are synced to megatest.db
    (if (member 'new2old options)
	(for-each
	 (lambda (run-id)
	   (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
		  (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
	     (db:delay-if-busy frundb)
	     (db:delay-if-busy mtdb)
	     ;; (db:delay-if-busy frundb)
	     ;; (db:delay-if-busy mtdb)
	     (if (eq? run-id 0)
		 (db:sync-tables (db:sync-main-list dbstruct) fromdb mtdb)
		 (db:sync-tables db:sync-tests-only fromdb mtdb))))
		 (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
		 (db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb))))
	 run-ids))
    ;; (db:close-all dbstruct)
    ;; (sqlite3:finalize! mdb)
    ))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)

Modified megatest.scm from [42ff41d3a5] to [027a7b81ad].

1264
1265
1266
1267
1268
1269
1270
1271

1272
1273
1274
1275


1276
1277
1278
1279
1280
1281
1282
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273


1274
1275
1276
1277
1278
1279
1280
1281
1282







-
+


-
-
+
+







	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      ;; keep this one local
      ;; (open-run-close db:clean-up #f)
      (db:multi-db-sync 
       #f ;; do all run-ids
       'new2old
       ;; 'new2old
       'killservers
       'dejunk
       'adj-testids
       'old2new
       ;; 'adj-testids
       ;; 'old2new
       'new2old
       )
      (set! *didsomething* #t)))

(if (args:get-arg "-mark-incompletes")
    (begin
      (if (not (launch:setup-for-run))