Megatest

Changes On Branch refactor-db-v1.61-shoeb
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Hide Diff Patch Side-by-Side Diff

Changes In Branch refactor-db-v1.61-shoeb Excluding Merge-Ins

This is equivalent to a diff from bf22a32f91 to 3c104e39df

2016-09-08
16:08
added helpful comments to open-run-close methods Closed-Leaf check-in: 3c104e39df user: srehman tags: refactor-db-v1.61-shoeb
14:44
merged with 1.62 check-in: 1029496a83 user: srehman tags: refactor-db-v1.61-shoeb
2016-09-07
17:57
added check for DISPLAY settings prior to launching dashboard check-in: f158e57b14 user: bjbarcla tags: v1.61
16:44
needed cleanup; one-run-updater wip bugfix check-in: 062b578b1b user: bjbarcla tags: v1.61_onerun
16:29
db updated check-in: 9a47c20038 user: ritikaag tags: db
15:56
Updated makefile to have less scary output when it can't find postgres and mysql check-in: 9a36d96247 user: jmoon18 tags: v1.61
2016-09-06
17:10
Create new branch named "refactor-db-v1.61-shoeb" check-in: ce9c0bd882 user: srehman tags: refactor-db-v1.61-shoeb
17:08
WIP: read-only area support. Better MT_ variable support. Not working properly yet. Closed-Leaf check-in: 3f19516a56 user: mrwellan tags: mrw_wip_fixes_ww37
2016-09-02
17:46
added colors on the graph check-in: bf22a32f91 user: ritikaag tags: v1.61
2016-08-31
16:48
Partial fixes for dashboard issues. WIP check-in: ee53267d1a user: mrwellan tags: v1.61, v1.6104

Modified db.scm from [e4bdea0e8f] to [7e725106a3].

︙
263
264
265
266
267
268
269
270
271
272



273
274
275
276
277
278
279

263
264
265
266
267
268
269



270
271
272
273
274
275
276
277
278
279








-
-
-
+
+
+








		  ;; (db:sync-tables db:sync-tests-only db inmem)
		  ;; (db:sync-tables db:sync-tests-only inmem refdb)
		  inmem)))))))

;; This routine creates the db. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let ((mdb (dbr:dbstruct-get-main dbstruct)))
    (if mdb
	mdb
  (let ((megatest-db (dbr:dbstruct-get-main dbstruct)))
    (if megatest-db
	megatest-db
	(begin
	  (mutex-lock! *rundb-mutex*)
	  (let* ((dbpath       (db:dbfile-path 0))
		 (dbexists     (file-exists? dbpath))
		 (db           (db:lock-create-open dbpath db:initialize-main-db))
		 (olddb        (db:open-megatest-db))
		 (write-access (file-write-access? dbpath))
︙
363
364
365
366
367
368
369
370
371
372



373
374

375
376
377
378
379
380
381

363
364
365
366
367
368
369



370
371
372
373

374
375
376
377
378
379
380
381








-
-
-
+
+
+

-
+








  (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))
  (let ((run-db (db:open-rundb dbstruct run-id do-not-open: #t)))
    (if (and run-db
	     (sqlite3:database? run-db))
	(begin
	  (sqlite3:finalize! rdb)
	  (sqlite3:finalize! run-db)
	  (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)
︙
703
704
705
706
707
708
709
710

711
712
713
714
715
716


717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733


734
735
736
737
738
739
740


741
742
743
744
745
746

747
748
749
750


751
752
753
754
755
756
757

703
704
705
706
707
708
709

710
711
712
713
714


715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731


732
733
734
735
736
737
738


739
740
741
742
743
744
745

746
747
748


749
750
751
752
753
754
755
756
757








-
+




-
-
+
+















-
-
+
+





-
-
+
+





-
+


-
-
+
+








;;  'closeall     - close all opened dbs
;;
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync run-ids . options)
  (let* ((toppath  (launch:setup))
	 (dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
	 (mtdb     (if toppath (db:open-megatest-db)))
	 (megatest-db     (if toppath (db:open-megatest-db)))
	 (allow-cleanup (if run-ids #f #t))
	 (run-ids  (if run-ids 
		       run-ids
		       (if toppath (begin
				     (db:delay-if-busy mtdb)
				     (db:get-all-run-ids mtdb)))))
				     (db:delay-if-busy megatest-db)
				     (db:get-all-run-ids megatest-db)))))
	 (tdbdat  (tasks:open-db))
	 (servers (tasks:get-all-servers (db:delay-if-busy tdbdat))))
    
    ;; kill servers
    (if (member 'killservers options)
	(for-each
	 (lambda (server)
	   (tasks:server-delete-record (db:delay-if-busy tdbdat) (vector-ref server 0) "dbmigration")
	   (tasks:kill-server (vector-ref server 2)(vector-ref server 1)))
	 servers))

    ;; clear out junk records
    ;;
    (if (member 'dejunk options)
	(begin
	  (db:delay-if-busy mtdb)
	  (db:clean-up mtdb)))
	  (db:delay-if-busy megatest-db)
	  (db:clean-up megatest-db)))

    ;; adjust test-ids to fit into proper range
    ;;
    (if (member 'adj-testids options)
	(begin
	  (db:delay-if-busy mtdb)
	  (db:prep-megatest.db-for-migration mtdb)))
	  (db:delay-if-busy megatest-db)
	  (db:prep-megatest.db-for-migration megatest-db)))

    ;; sync runs, test_meta etc.
    ;;
    (if (member 'old2new options)
	(begin
	  (db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
	  (db:sync-tables (db:sync-main-list megatest-db) megatest-db (db:get-db dbstruct #f))
	  (for-each 
	   (lambda (run-id)
	     (db:delay-if-busy mtdb)
	     (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))
	     (db:delay-if-busy megatest-db)
	     (let ((testrecs (db:get-all-tests-info-by-run-id megatest-db run-id))
		   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
	       (debug:print 0 *default-log-port* "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db")
	       (db:replace-test-records dbstruct run-id testrecs)
	       (sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-get-rundb dbstruct)))))
	   run-ids)))

    ;; now ensure all newdb data are synced to megatest.db
︙
771
772
773
774
775
776
777
778

779
780
781
782
783
784
785

771
772
773
774
775
776
777

778
779
780
781
782
783
784
785








-
+








	     (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:clean-up frundb)
	       (if (eq? run-id 0)
		   (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
		     (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
		     (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) megatest-db)
		     (set! dead-runs (db:clean-up-maindb (db:get-db fromdb #f)))
		     ;; 
		     ;; Feb 18, 2016: add field last_update to runs table
		     ;;
		     ;; remove all these some time after september 2016 (added in v1.6031
		     ;;
		     (handle-exceptions
︙
811
812
813
814
815
816
817
818

819
820
821
822
823
824
825

811
812
813
814
815
816
817

818
819
820
821
822
823
824
825








-
+








                               BEGIN 
                                 UPDATE run_stats SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;")
		     )
		   (begin
		     ;; NB// must sync first to ensure deleted tests get marked as such in megatest.db
		     (db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb)
		     (db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) megatest-db)
		     (db:clean-up-rundb (db:get-db fromdb run-id))
		     ;;
		     ;; Feb 18, 2016: add field last_update to tests, test_steps and test_data
		     ;;
		     ;; remove this some time after September 2016 (added in version v1.6031
		     ;;
		     (for-each
︙
857
858
859
860
861
862
863


864
865
866
867
868
869
870

857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872








+
+








		      dead-runs))))

    ;; (db:close-all dbstruct)
    ;; (sqlite3:finalize! mdb)
    ))

;; keeping it around for debugging purposes only
;; idb = incoming db
;;
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 *default-log-port* "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (if (or *db-write-access*
	  (not (member proc *db:all-write-procs*)))
      (let* ((db (cond
		  ((pair? idb)                 (db:dbdat-get-db idb))
		  ((sqlite3:database? idb)     idb)
︙
2588
2589
2590
2591
2592
2593
2594
2595

2596
2597
2598
2599
2600
2601
2602
2603

2604
2605
2606
2607
2608
2609
2610
2611

2612
2613
2614
2615

2616
2617
2618
2619
2620
2621

2622
2623
2624
2625
2626
2627
2628


2629
2630
2631
2632


2633
2634
2635
2636
2637
2638
2639

2590
2591
2592
2593
2594
2595
2596

2597
2598
2599
2600
2601
2602
2603
2604

2605
2606
2607
2608
2609
2610
2611
2612

2613
2614
2615
2616

2617
2618
2619
2620
2621
2622

2623
2624
2625
2626
2627
2628


2629
2630
2631
2632


2633
2634
2635
2636
2637
2638
2639
2640
2641








-
+







-
+







-
+



-
+





-
+





-
-
+
+


-
-
+
+








			;; (debug:print 0 *default-log-port* "INFO: Inserting values: " (string-intersperse (map conc (vector->list rec)) ",") "\n")
			(apply sqlite3:execute qry (vector->list rec)))
		      testrecs)))
		  (sqlite3:finalize! qry)))))

;; map a test-id into the proper range
;;
(define (db:adj-test-id mtdb min-test-id test-id)
(define (db:adj-test-id megatest-db min-test-id test-id)
  (if (>= test-id min-test-id)
      test-id
      (let loop ((new-id min-test-id))
	(let ((test-id-found #f))
	  (sqlite3:for-each-row 
	   (lambda (id)
	     (set! test-id-found id))
	   (db:dbdat-get-db mtdb)
	   (db:dbdat-get-db megatest-db)
	   "SELECT id FROM tests WHERE id=?;"
	   new-id)
	  ;; if test-id-found then need to try again
	  (if test-id-found
	      (loop (+ new-id 1))
	      (begin
		(debug:print-info 0 *default-log-port* "New test id " new-id " selected for test with id " test-id)
		(sqlite3:execute mtdb "UPDATE tests SET id=? WHERE id=?;" new-id test-id)))))))
		(sqlite3:execute megatest-db "UPDATE tests SET id=? WHERE id=?;" new-id test-id)))))))

;; move test ids into the 30k * run_id range
;;
(define (db:prep-megatest.db-adj-test-ids mtdb run-id testrecs)
(define (db:prep-megatest.db-adj-test-ids megatest-db run-id testrecs)
  (debug:print-info 0 *default-log-port* "Adjusting test ids in megatest.db for run " run-id)
  (let ((min-test-id (* run-id 30000)))
    (for-each 
     (lambda (testrec)
       (let* ((test-id (vector-ref testrec (db:field->number "id" db:test-record-fields))))
	 (db:adj-test-id (db:dbdat-get-db mtdb) min-test-id test-id)))
	 (db:adj-test-id (db:dbdat-get-db megatest-db) min-test-id test-id)))
     testrecs)))
	
;; 1. move test ids into the 30k * run_id range
;; 2. move step ids into the 30k * run_id range
;;
(define (db:prep-megatest.db-for-migration mtdb)
  (let* ((run-ids (db:get-all-run-ids mtdb)))
(define (db:prep-megatest.db-for-migration megatest-db)
  (let* ((run-ids (db:get-all-run-ids megatest-db)))
    (for-each 
     (lambda (run-id)
       (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
	 (db:prep-megatest.db-adj-test-ids (db:dbdat-get-db mtdb) run-id testrecs)))
       (let ((testrecs (db:get-all-tests-info-by-run-id megatest-db run-id)))
	 (db:prep-megatest.db-adj-test-ids (db:dbdat-get-db megatest-db) run-id testrecs)))
     run-ids)))

;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
︙

Modified megatest-version.scm from [1eea1a53bb] to [a7deac7bb7]. 

1
2
3
4
5
6

7

1
2
3
4
5

6
7






-
+


;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6104)
(define megatest-version 1.6201)

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