Megatest

Check-in [947952bcfb]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:dashboard runs
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.90-proper-interface-lists
Files: files | file ages | folders
SHA1: 947952bcfb298a4cefc693d023f00b9709761f04
User & Date: mrwellan on 2024-02-13 15:17:08
Other Links: branch diff | manifest | tags
Context
2024-02-13
15:51
wip check-in: 55d3f1d05d user: mrwellan tags: v1.90-proper-interface-lists
15:17
dashboard runs check-in: 947952bcfb user: mrwellan tags: v1.90-proper-interface-lists
12:40
megatest -repl and -h work check-in: 65618b033e user: mrwellan tags: v1.90-proper-interface-lists
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified commonmod.scm from [fbed9e11d0] to [60b164c1f9].

︙
49
50
51
52
53
54
55









56
57
58
59
60
61
62

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71








+
+
+
+
+
+
+
+
+








     z3)

(import stml2
	)

(module commonmod
	(
	 db:testmeta-get-owner 
	 db:testmeta-get-author
	 db:testmeta-get-description
	 db:testmeta-get-reviewed
	 db:testmeta-get-tags
	 make-db:testmeta
	 
	 common:sparse-list-generate-index
	 common:lazy-sqlite-db-modification-time
	 make-sparse-array
	 sparse-array-set!
	 sparse-array-ref
	 keys->valslots
	 item-list->path
	 common:human-time
	 number-of-processes-running
︙
171
172
173
174
175
176
177

178
179
180
181
182
183
184

180
181
182
183
184
185
186
187
188
189
190
191
192
193
194








+









	 tests:match
	 patt-list-match
	 common:pkts-spec

	 sdb:qry
	 seconds->work-week/day-time
	 seconds->work-week/day

	 tdb:step-get-comment
	 seconds->hr-min-sec
	 any->number
	 tdb:step-get-logfile
	 tdb:step-get-event_time
	 tdb:step-get-status
︙

Modified dashboard.scm from [21bf76042d] to [6564a08811].

︙
105
106
107
108
109
110
111
112

113
114
115
116
117
118
119

105
106
107
108
109
110
111

112
113
114
115
116
117
118
119








-
+








	stml2
	megatestmod
	tasksmod
	runsmod
	testsmod
	)

;; (include "common_records.scm")
(include "common_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")
︙
170
171
172
173
174
175
176
177
178


179
180
181
182
183
184
185

170
171
172
173
174
175
176


177
178
179
180
181
182
183
184
185








-
-
+
+








		 0))

(if (args:get-arg "-mode")
    (let* ((mode (string->symbol (args:get-arg "-mode"))))
      (rmt:transport-mode mode)))
;;  (rmt:transport-mode 'tcp))

(if (args:get-arg "-test") ;; need to use tcp for test control panel
    (rmt:transport-mode 'tcp))
;; (if (args:get-arg "-test") ;; need to use tcp for test control panel
;;     (rmt:transport-mode 'tcp))

;; RA => Might require revert for filters 
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")
︙

Modified dbmod.scm from [f66568c37d] to [2ba06f0555].

︙
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570

















1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584







1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605





















1606
1607
1608
1609
1610
1611
1612

1547
1548
1549
1550
1551
1552
1553

















1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577







1578
1579
1580
1581
1582
1583
1584





















1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








                       (begin
			 (db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) #f tmpdb mtdb)))
		   (hash-table-set! sync-durations (conc srcfile ".db") (- (current-milliseconds) start-time)))
		 (debug:print-info 2 *default-log-port* "skipping delta sync. " srcfile " is up to date"))))
	 dbfiles))
    data-synced))

;; Sync all changed db's
;;
(define (db:tmp->megatest.db-sync dbstruct run-id last-update)
  (let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct)))
	 (res    '()))
    (for-each
     (lambda (subdb)
       (let* ((mtdb   (dbr:subdb-mtdbdat subdb))
	      (tmpdb  (db:get-subdb dbstruct run-id))
	      (refndb (dbr:subdb-refndb subdb))
	      (newres (db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) last-update tmpdb refndb mtdb)))
	 ;; (stack-push! (dbr:subdb-dbstack subdb) tmpdb)
	 ;; BUG: verify this is really needed
	 (dbfile:add-dbdat dbstruct run-id tmpdb)
	 (set! res (cons newres res))))
     subdbs)
    res))
;; ;; Sync all changed db's
;; ;;
;; (define (db:tmp->megatest.db-sync dbstruct run-id last-update)
;;   (let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct)))
;; 	 (res    '()))
;;     (for-each
;;      (lambda (subdb)
;;        (let* ((mtdb   (dbr:subdb-mtdbdat subdb))
;; 	      (tmpdb  (db:get-subdb dbstruct run-id))
;; 	      (refndb (dbr:subdb-refndb subdb))
;; 	      (newres (db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) last-update tmpdb refndb mtdb)))
;; 	 ;; (stack-push! (dbr:subdb-dbstack subdb) tmpdb)
;; 	 ;; BUG: verify this is really needed
;; 	 (dbfile:add-dbdat dbstruct run-id tmpdb)
;; 	 (set! res (cons newres res))))
;;      subdbs)
;;     res))

;;;; run-ids
;;    if #f use *db-local-sync* : or 'local-sync-flags
;;    if #t use timestamps      : or 'timestamps
;;
;;  NB// no-sync-db is the db handle, not a flag!
;;
(define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f)) 
  (let* ((start-time         (current-seconds))
	 (last-full-update   (if no-sync-db
				 (db:no-sync-get/default no-sync-db "LAST_FULL_UPDATE" 0)
				 0))
	 (full-sync-needed   (> (- start-time last-full-update) 3600)) ;; every hour do a full sync
	 (last-update        (if full-sync-needed
;; (define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f)) 
;;   (let* ((start-time         (current-seconds))
;; 	 (last-full-update   (if no-sync-db
;; 				 (db:no-sync-get/default no-sync-db "LAST_FULL_UPDATE" 0)
;; 				 0))
;; 	 (full-sync-needed   (> (- start-time last-full-update) 3600)) ;; every hour do a full sync
;; 	 (last-update        (if full-sync-needed
				 0
				 (if no-sync-db
				     (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
				     0))) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
	 (sync-needed        (> (- start-time last-update) 6))
	 (res                (if (or sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
				     full-sync-needed)
				 (begin
				   (if no-sync-db
				       (begin
					 (if full-sync-needed (db:no-sync-set no-sync-db "LAST_FULL_UPDATE" start-time))
					 (db:no-sync-set no-sync-db "LAST_UPDATE" start-time)))
				   (db:tmp->megatest.db-sync dbstruct last-update))
				 0))
	 (sync-time           (- (current-seconds) start-time)))
      (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
      (if (common:low-noise-print 30 "sync new to old")
          (if sync-needed
              (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
              (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
      res))
;; 				 0
;; 				 (if no-sync-db
;; 				     (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
;; 				     0))) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
;; 	 (sync-needed        (> (- start-time last-update) 6))
;; 	 (res                (if (or sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
;; 				     full-sync-needed)
;; 				 (begin
;; 				   (if no-sync-db
;; 				       (begin
;; 					 (if full-sync-needed (db:no-sync-set no-sync-db "LAST_FULL_UPDATE" start-time))
;; 					 (db:no-sync-set no-sync-db "LAST_UPDATE" start-time)))
;; 				   (db:tmp->megatest.db-sync dbstruct run-id last-update))
;; 				 0))
;; 	 (sync-time           (- (current-seconds) start-time)))
;;       (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
;;       (if (common:low-noise-print 30 "sync new to old")
;;           (if sync-needed
;;               (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
;;               (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
;;       res))


(define (db:initialize-main-db db #!key (launch-setup #f))
  (when (not *configinfo*)
    (if launch-setup
	(launch-setup) ;; added because Elena was getting stack dump because *configinfo* below was #f.
	(assert #f "db:initialize-main-db called and needs launch:setup but was not given it")))
︙

Modified mtbody.scm from [c8247e48cf] to [e2a9979161].

︙
313
314
315
316
317
318
319
320

321
322
323
324
325
326
327

313
314
315
316
317
318
319

320
321
322
323
324
325
326
327








-
+








  ;;
  (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
    (if (common:file-exists? debugcontrolf)
	(load debugcontrolf)))

  ;; usage logging, careful with this, it is not designed to deal with all real world challenges!
  ;;
  (if (and *usage-log-file*
  (if (and (string? *usage-log-file*)
           (file-write-access? *usage-log-file*))
      (with-output-to-file
          *usage-log-file*
	(lambda ()
          (print (if *usage-use-seconds*
		     (current-seconds)
		     (time->string
︙

Modified rmtmod.scm from [981fa22127] to [dd52b41e4b].

︙
27
28
29
30
31
32
33




34
35
36
37
38
39
40

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44








+
+
+
+








(declare (uses mtmod))
(declare (uses tcp-transportmod))
(declare (uses apimod))
(declare (uses servermod))

(module rmtmod
	(
	 rmt:read-test-data
	 rmt:get-targets
	 rmt:get-run-stats
	 rmt:get-key-vals
	 rmt:test-data-rollup
	 rmt:import-sexpr
	 rmt:read-test-data-varpatt
	 rmt:get-run-status
	 rmt:set-run-status

	 rmtmod:send-receive
︙

Modified subrunmod.scm from [f63d1179cd] to [b3d10da4e7].

︙
39
40
41
42
43
44
45


46
47
48
49
50
51
52

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54








+
+








(declare (uses megatestmod))
(declare (uses tasksmod))

(use srfi-69)

(module subrunmod
	(
	 subrun:launch-dashboard 
	 subrun:get-runarea
	 subrun:set-state-status
	 subrun:kill-subrun
	 subrun:get-log-path
	 subrun:remove-subrun
	 subrun:subrun-removed?
	 subrun:subrun-test-initialized?
	 subrun:launch-cmd
︙

Modified tasksmod.scm from [7361eb58d0] to [ed55eb9fc6].

︙
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66

52
53
54
55
56
57
58

59
60
61
62
63
64
65
66








-
+








	 tests:get-waitons

	 tests:get-test-path-from-environment
	 common:exit-on-version-changed
	 task:get-run-times
	 task:get-test-times
	 tasks:sync-to-postgres

	 tests:get-full-data
	 )

(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
︙

Modified testsmod.scm from [db63cb4f1d] to [12dae6da6a].

︙
41
42
43
44
45
46
47

48

49
50
51
52
53
54
55

41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56








+
-
+








(use srfi-69)

(module testsmod
	(
	 tests:summarize-items
	 tests:filter-non-runnable
	 tests:sort-by-priority-and-waiton
	 tests:lazy-dot

	 
	 tests:summarize-test
	 tests:save-final-status
	 tests:update-central-meta-info
	 tests:set-full-meta-info
	 tests:get-compressed-steps
	 tests:create-html-summary
	 tests:create-html-summary
︙

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