Megatest

Check-in [7636717b91]
Login
Overview
Comment:Merged in fixes from v1.60 branch
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | refactor-sqlite3-calls
Files: files | file ages | folders
SHA1: 7636717b9151aada94990f49f773363dd0a0e9bb
User & Date: matt on 2014-10-08 22:46:20
Other Links: branch diff | manifest | tags
Context
2014-10-09
00:01
Added snipped of example code in comment to tree.scm Closed-Leaf check-in: dfe733bf8a user: matt tags: refactor-sqlite3-calls
2014-10-08
22:46
Merged in fixes from v1.60 branch check-in: 7636717b91 user: matt tags: refactor-sqlite3-calls
13:07
new2old needed to handle multi sync in megatest.scm correctly check-in: 5c03cce6b3 user: mrwellan tags: v1.60
03:55
updated stats check-in: bbeec077ff user: matt tags: refactor-sqlite3-calls
Changes

Modified common.scm from [3b338cd1db] to [c65e994a50].

50
51
52
53
54
55
56

57
58
59
60
61
62
63
(define *alt-log-file* #f)  ;; used by -log

;; DATABASE
(define *dbstruct-db*  #f)
(define *db-stats* (make-hash-table)) ;; hash of vectors < count duration-total >
(define *db-stats-mutex*      (make-mutex))
(define *db-sync-mutex*       (make-mutex))

(define *db-local-sync*       (make-hash-table)) ;; used to record last touch of db
(define *megatest-db*         #f)
(define *last-db-access*      (current-seconds))  ;; update when db is accessed via server
(define *db-write-access*     #t)
(define *inmemdb*             #f)
(define *task-db*             #f) ;; (vector db path-to-db)








>







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
(define *alt-log-file* #f)  ;; used by -log

;; DATABASE
(define *dbstruct-db*  #f)
(define *db-stats* (make-hash-table)) ;; hash of vectors < count duration-total >
(define *db-stats-mutex*      (make-mutex))
(define *db-sync-mutex*       (make-mutex))
(define *db-multi-sync-mutex* (make-mutex))
(define *db-local-sync*       (make-hash-table)) ;; used to record last touch of db
(define *megatest-db*         #f)
(define *last-db-access*      (current-seconds))  ;; update when db is accessed via server
(define *db-write-access*     #t)
(define *inmemdb*             #f)
(define *task-db*             #f) ;; (vector db path-to-db)

Modified dashboard.scm from [3ab66e328b] to [f6eb70a199].

471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
					     (car matching))))
			   (testname   (db:test-get-testname  test))
			   (itempath   (db:test-get-item-path test))
			   (testfullname (test:test-get-fullname test))
			   (teststatus (db:test-get-status   test))
			   (teststate  (db:test-get-state    test))
			   ;;(teststart  (db:test-get-event_time test))
			   (runtime    (db:test-get-run_duration test))
			   (buttontxt  (cond
					((equal? teststate "COMPLETED") teststatus)
					((and (equal? teststate "NOT_STARTED")
					      (member teststatus '("ZERO_ITEMS" "BLOCKED" "PREQ_FAIL" "PREQ_DISCARDED" "TIMED_OUT" "KEEP_TRYING" "TEN_STRIKES")))
					 teststatus)
					(else
					 teststate)))







|







471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
					     (car matching))))
			   (testname   (db:test-get-testname  test))
			   (itempath   (db:test-get-item-path test))
			   (testfullname (test:test-get-fullname test))
			   (teststatus (db:test-get-status   test))
			   (teststate  (db:test-get-state    test))
			   ;;(teststart  (db:test-get-event_time test))
			   ;;(runtime    (db:test-get-run_duration test))
			   (buttontxt  (cond
					((equal? teststate "COMPLETED") teststatus)
					((and (equal? teststate "NOT_STARTED")
					      (member teststatus '("ZERO_ITEMS" "BLOCKED" "PREQ_FAIL" "PREQ_DISCARDED" "TIMED_OUT" "KEEP_TRYING" "TEN_STRIKES")))
					 teststatus)
					(else
					 teststate)))

Modified db.scm from [6079da4d93] to [8fe161caf5].

522
523
524
525
526
527
528
529
530
531
532


533
534
535
536
537
538
539
540
		   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
	       (debug:print 0 "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
	       (db:replace-test-records dbstruct run-id testrecs)
	       (sqlite3:finalize! (dbr:dbstruct-get-rundb dbstruct))))
	   run-ids)))

    ;; now ensure all newdb data are synced to megatest.db
    (if (member 'old2new options)
	(for-each
	 (lambda (run-id)
	   (let ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))


	     (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)







|



>
>
|







522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
		   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
	       (debug:print 0 "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
	       (db:replace-test-records dbstruct run-id testrecs)
	       (sqlite3:finalize! (dbr:dbstruct-get-rundb dbstruct))))
	   run-ids)))

    ;; 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)))
	     (if (eq? run-id 0)
		 (db:sync-tables (db:sync-main-list dbstruct)(db:get-db fromdb run-id) 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 [40af9ed55b] to [fd46dc3bc6].

121
122
123
124
125
126
127

128
129
130
131
132
133
134
  -var varName            : for config and runconfig lookup value for sectionName varName

Misc 
  -start-dir path         : switch to this directory before running megatest
  -rebuild-db             : bring the database schema up to date
  -cleanup-db             : remove any orphan records, vacuum the db
  -import-megatest.db     : migrate a database from v1.55 series to v1.60 series

  -update-meta            : update the tests metadata for all tests
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -daemonize              : fork into background and disconnect from stdin/out
  -log logfile            : send stdout and stderr to logfile







>







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
  -var varName            : for config and runconfig lookup value for sectionName varName

Misc 
  -start-dir path         : switch to this directory before running megatest
  -rebuild-db             : bring the database schema up to date
  -cleanup-db             : remove any orphan records, vacuum the db
  -import-megatest.db     : migrate a database from v1.55 series to v1.60 series
  -sync-to-megatest.db    : migrate data back to megatest.db
  -update-meta            : update the tests metadata for all tests
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -daemonize              : fork into background and disconnect from stdin/out
  -log logfile            : send stdout and stderr to logfile
267
268
269
270
271
272
273

274
275
276
277
278
279
280
			"-update-meta"
			"-gen-megatest-area"
			"-mark-incompletes"

			"-convert-to-norm"
			"-convert-to-old"
			"-import-megatest.db"


			"-logging"
			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
		       )
		 args:arg-hash
		 0))







>







268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
			"-update-meta"
			"-gen-megatest-area"
			"-mark-incompletes"

			"-convert-to-norm"
			"-convert-to-old"
			"-import-megatest.db"
			"-sync-to-megatest.db"

			"-logging"
			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
		       )
		 args:arg-hash
		 0))
1307
1308
1309
1310
1311
1312
1313









1314
1315
1316
1317
1318
1319
1320
       'killservers
       'dejunk
       'adj-testids
       'old2new
       'new2old
       )
      (set! *didsomething* #t)))









;;======================================================================
;; Exit and clean up
;;======================================================================

(if *runremote* (close-all-connections!))

(if (not *didsomething*)







>
>
>
>
>
>
>
>
>







1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
       'killservers
       'dejunk
       'adj-testids
       'old2new
       'new2old
       )
      (set! *didsomething* #t)))

(if (args:get-arg "-sync-to-megatest.db")
    (begin
      (db:multi-db-sync 
       #f ;; do all run-ids
       'new2old
       )
      (set! *didsomething* #t)))

;;======================================================================
;; Exit and clean up
;;======================================================================

(if *runremote* (close-all-connections!))

(if (not *didsomething*)

Modified rmt.scm from [b74fc0e720] to [d4f16a53b3].

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
    (let* ((start         (current-milliseconds))
	   (res           (api:execute-requests dbstruct-local (symbol->string cmd) params))
	   (duration      (- (current-milliseconds) start)))
      (rmt:update-db-stats cmd params duration)
      ;; mark this run as dirty if this was a write
      (if (not (member cmd api:read-only-queries))
	  (let ((start-time (current-seconds)))
	    (mutex-lock! *db-sync-mutex*)
	    (let ((last-sync (hash-table-ref/default *db-local-sync* run-id 0)))
	      (if (> (- start-time last-sync) 5) ;; every five seconds
		  (begin
		    (db:multi-db-sync run-id 'new2old)
		    (debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " (- (current-seconds) start-time) " seconds")
		    (hash-table-set! *db-local-sync* run-id start-time))))
	    (mutex-unlock! *db-sync-mutex*)))
      res)))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((run-id   (if run-id run-id 0))
	 (jparams         (db:obj->string params)) ;; (rmt:dat->json-str params))
	 (res (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
    (if res







|



|


|







148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
    (let* ((start         (current-milliseconds))
	   (res           (api:execute-requests dbstruct-local (symbol->string cmd) params))
	   (duration      (- (current-milliseconds) start)))
      (rmt:update-db-stats cmd params duration)
      ;; mark this run as dirty if this was a write
      (if (not (member cmd api:read-only-queries))
	  (let ((start-time (current-seconds)))
	    (mutex-lock! *db-multi-sync-mutex*)
	    (let ((last-sync (hash-table-ref/default *db-local-sync* run-id 0)))
	      (if (> (- start-time last-sync) 5) ;; every five seconds
		  (begin
		    (db:multi-db-sync (list run-id) 'new2old)
		    (debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " (- (current-seconds) start-time) " seconds")
		    (hash-table-set! *db-local-sync* run-id start-time))))
	    (mutex-unlock! *db-multi-sync-mutex*)))
      res)))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((run-id   (if run-id run-id 0))
	 (jparams         (db:obj->string params)) ;; (rmt:dat->json-str params))
	 (res (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
    (if res