Megatest

Check-in [332dd9df31]
Login
Overview
Comment:Changed .megatest to .mtdb in several places
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 332dd9df31542360769379dbde417b3b84348b00
User & Date: mmgraham on 2023-03-22 19:40:00
Other Links: branch diff | manifest | tags
Context
2023-03-27
15:49
Removed use of margs check-in: fba5bad548 user: mrwellan tags: v1.80
13:06
changed more cases of .megatest to .mtdb check-in: 85ebde8764 user: mmgraham tags: v1.80
2023-03-22
19:40
Changed .megatest to .mtdb in several places check-in: 332dd9df31 user: mmgraham tags: v1.80
13:01
Merged fork check-in: 9fe68a8fb2 user: mrwellan tags: v1.80, v1.8011
Changes

Modified db.scm from [89dbc08fee] to [7db3e81d62].

589
590
591
592
593
594
595
596

597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612


613
614
615
616
617
618
619
589
590
591
592
593
594
595

596
597
598
599
600
601
602
603
604
605
606
607
608
609
610


611
612
613
614
615
616
617
618
619







-
+














-
-
+
+







	 (data-synced 0) ;; count of changed records
	 (tmp-area       (common:get-db-tmp-area))
	 (old2new (member 'old2new options))
	 (dejunk (member 'dejunk options))
	 (killservers (member 'killservers options))
	 (src-area (if old2new *toppath* tmp-area))
	 (dest-area (if old2new tmp-area *toppath*))
	 (dbfiles        (if old2new (glob (conc *toppath* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.db"))))
	 (dbfiles        (if old2new (glob (conc *toppath* "/.mtdb/*.db")) (glob (conc tmp-area "/.mtdt/*.db"))))
	 (keys (db:get-keys dbstruct))
	 (sync-durations (make-hash-table)))

    ;; kill servers
    (if killservers (db:kill-servers))
    
    (if (not dbfiles)
	(debug:print-error 0 *default-log-port* "no dbfiles found in " (conc *toppath* "/.megatest"))
	(for-each
	 (lambda (srcfile)
	   (debug:print-info 3 *default-log-port* "file: " srcfile)
	   (let* ((fname    (conc (pathname-file srcfile) ".db"))
		  (basename (pathname-file srcfile))
		  (run-id   (if (string= basename "main") #f (string->number basename)))
		  (destfile (conc dest-area "/.megatest/" fname))
		  (dest-directory  (conc dest-area "/.megatest/"))
		  (destfile (conc dest-area "/.mtdb/" fname))
		  (dest-directory  (conc dest-area "/.mtdb/"))
		  (time1    (file-modification-time srcfile))
		  (time2    (if (file-exists? destfile)
				(begin
				  (debug:print-info 2 *default-log-port* "destfile " destfile " exists")
				  (file-modification-time destfile))
				(begin
				  (debug:print-info 0 *default-log-port* "Sync - I do not see file " destfile)
1810
1811
1812
1813
1814
1815
1816
1817

1818
1819
1820
1821
1822
1823
1824
1810
1811
1812
1813
1814
1815
1816

1817
1818
1819
1820
1821
1822
1823
1824







-
+








;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db)
;;
;; NOTE: This DOESN'T (necessarily) get the real run ids, but the number of the <number>.db!!

(define (db:get-changed-run-ids since-time)
  (let* ((dbdir      (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir"))
	 (alldbs     (glob (conc dbdir "/.megatest/[0-9]*.db")))
	 (alldbs     (glob (conc dbdir "/.mtdb/[0-9]*.db")))
	 (changed    (filter (lambda (dbfile)
			       (> (file-modification-time dbfile) since-time))
			     alldbs)))
    (delete-duplicates
     (map (lambda (dbfile)
	    (let* ((res (string-match ".*\\/(\\d\\d)\\.db" dbfile)))
	      (if res
4520
4521
4522
4523
4524
4525
4526
4527

4528
4529
4530
4531
4532
4533

4534
4535
4536
4537
4538
4539
4540
4520
4521
4522
4523
4524
4525
4526

4527
4528
4529
4530
4531
4532

4533
4534
4535
4536
4537
4538
4539
4540







-
+





-
+







	  #f
        ))))

;; sync for filesystem local db writes
;;
(define (db:run-lock-and-sync no-sync-db)
  (let* ((tmp-area       (common:get-db-tmp-area))
	 (dbfiles        (glob (conc tmp-area"/.megatest/*.db")))
	 (dbfiles        (glob (conc tmp-area"/.mtdb/*.db")))
	 (sync-durations (make-hash-table)))
    ;; (debug:print-info 0 *default-log-port* "lock-and-sync, dbfiles: "dbfiles)
    (for-each
     (lambda (file)
       (let* ((fname (conc (pathname-file file) ".db"))
	      (fulln (conc *toppath*"/.megatest/"fname))
	      (fulln (conc *toppath*"/.mtdb/"fname))
	      (time1 (if (file-exists? file)
			 (file-modification-time file)
			 (begin
			   (debug:print-info 0 *default-log-port* "Sync - I do not see file "file)
			   1)))
	      (time2 (if (file-exists? fulln)
			 (file-modification-time fulln)

Modified dbfile.scm from [7406bd8270] to [d5febb23fb].

43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57







-
+







	)

;; parameters
;;
(define dbfile:testsuite-name (make-parameter #f))

(define keep-age-param        (make-parameter 10))      ;; qif file age, if over move to attic
(define num-run-dbs           (make-parameter 10))      ;; number of db's in .megatest
(define num-run-dbs           (make-parameter 10))      ;; number of db's in .mtdb
(define dbfile:sync-method    (make-parameter 'attach)) ;; 'attach or 'original
(define dbfile:cache-method   (make-parameter 'inmem))  ;; 'direct

;; 'original     - use old condition code
;; 'suicide-mode - create mtrah/stop-the-train with info on what went wrong
;; else use no condition code (should be production mode)
;;
81
82
83
84
85
86
87
88
89


90
91
92
93


94
95
96
97
98
99
100
81
82
83
84
85
86
87


88
89
90
91


92
93
94
95
96
97
98
99
100







-
-
+
+


-
-
+
+







  (last-update 0)
  (sync-proc #f)
  )

;; NOTE: Need one dbr:subdb per main.db, 1.db ...
;;
(defstruct dbr:subdb
  (dbname      #f) ;; .megatest/1.db
  (mtdbfile    #f) ;; mtrah/.megatest/1.db
  (dbname      #f) ;; .mtdb/1.db
  (mtdbfile    #f) ;; mtrah/.mtdb/1.db
  (mtdbdat     #f) ;; only need one of these for syncing
  ;; (dbdats      (make-hash-table))  ;; id => dbdat 
  (tmpdbfile   #f) ;; /tmp/.../.megatest/1.db
  ;; (refndbfile  #f) ;; /tmp/.../.megatest/1.db_ref
  (tmpdbfile   #f) ;; /tmp/.../.mtdb/1.db
  ;; (refndbfile  #f) ;; /tmp/.../.mtdb/1.db_ref
  (dbstack     (make-stack)) ;; stack for tmp dbr:dbdat,
  (homehost    #f) ;; not used yet
  (on-homehost #f) ;; not used yet
  (read-only   #f)
  (last-sync   0)
  (last-write  (current-seconds))
  )                ;; goal is to converge on one struct for an area but for now it is too confusing

Modified runs.scm from [9ed9863b9e] to [aaf94af15e].

2390
2391
2392
2393
2394
2395
2396
2397

2398
2399
2400
2401
2402
2403
2404
2390
2391
2392
2393
2394
2395
2396

2397
2398
2399
2400
2401
2402
2403
2404







-
+







	 (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
	 (rp-mutex     (make-mutex))
	 (bup-mutex    (make-mutex))
         (keep-records (args:get-arg "-keep-records")) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode".
	 (test-records '())) ;; for tasks that we wish to operate on all tests in one fell swoop

    (let* ((write-access-actions '(remove-runs set-state-status archive run-wait kill-runs))
           (dbfile             (conc  *toppath* "/.megatest/main.db"))
           (dbfile             (conc  *toppath* "/.mtdb/main.db"))
           (readonly-mode      (not (file-write-access? dbfile))))
      (when (and readonly-mode
                 (member action write-access-actions))
        (debug:print-error 0 *default-log-port* dbfile " is readonly.  Cannot proceed with action ["action"] in which write-access isrequired .")
        (exit 1)))
    
    (debug:print-info 4 *default-log-port* "runs:operate-on => Header: " header " action: " action " new-state-status: " new-state-status)