Megatest

Diff
Login

Differences From Artifact [16f8f4859b]:

To Artifact [289eaba234]:


84
85
86
87
88
89
90

91



92
93
94

95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
84
85
86
87
88
89
90
91

92
93
94
95
96

97

98
99
100
101
102


103
104
105
106
107
108
109







+
-
+
+
+


-
+
-





-
-







      (exit)))

(if (not (setup-for-run))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

(define *dbdir* (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbstruct-local*  (make-dbr:dbstruct path: *toppath* local: #t))
(define *dbstruct-local*  (make-dbr:dbstruct path:  *dbdir*
					     local: #t))
(define *db-file-path* (db:dbfile-path 0))

;; HACK ALERT: this is a hack, please fix.
(define *read-only* (not (file-read-access? (conc *toppath* "db/main.db"))))
(define *read-only* (not (file-read-access? *db-file-path*)))
;; (client:setup *dbstruct-local*)

(define toplevel #f)
(define dlg      #f)
(define max-test-num 0)
(define *keys*   (db:get-keys *dbstruct-local*))
;; (define *keys*   (cdb:remote-run db:get-keys #f))
;; (define *keys*   (db:get-keys   *dbstruct-local*))

(define *dbkeys*  (append *keys* (list "runname")))

(define *header*       #f)
(define *allruns*     '())
(define *allruns-by-id* (make-hash-table)) ;; 
(define *runchangerate* (make-hash-table))
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
129
130
131
132
133
134
135


136
137
138
139
140
141
142







-
-







(define *start-run-offset*  0)
(define *start-test-offset* 0)
(define *examine-test-dat* (make-hash-table))
(define *exit-started* #f)
(define *status-ignore-hash* (make-hash-table))
(define *state-ignore-hash*  (make-hash-table))

(define *db-file-path* (conc *toppath* "/db/main.db"))

(define *tests-sort-options* (vector (vector "Sort +a" 'testname   "ASC")
				     (vector "Sort -a" 'testname   "DESC")
				     (vector "Sort +t" 'event_time "ASC")
				     (vector "Sort -t" 'event_time "DESC")
				     (vector "Sort +s" 'statestatus "ASC")
				     (vector "Sort -s" 'statestatus "DESC")))

1408
1409
1410
1411
1412
1413
1414
1415

1416
1417
1418
1419

1420
1421
1422

1423
1424
1425
1426
1427
1428
1429
1430

1431
1432
1433
1434
1435
1436
1437
1438
1439
1440

1441
1442
1443
1444
1445
1446
1447
1406
1407
1408
1409
1410
1411
1412

1413
1414
1415
1416

1417
1418
1419

1420
1421
1422
1423
1424
1425
1426
1427

1428
1429
1430
1431
1432
1433
1434
1435
1436
1437

1438
1439
1440
1441
1442
1443
1444
1445







-
+



-
+


-
+







-
+









-
+







(define *tim* (iup:timer))
(define *ord* #f)
(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")

;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
;;
(define *last-db-update-time* (file-modification-time (conc *toppath* "/db/main.db")))
(define *last-db-update-time* (file-modification-time *db-file-path*)) ;; (conc *toppath* "/db/main.db")))
(define *last-recalc-ended-time* 0)

(define (dashboard:been-changed)
  (> (file-modification-time (conc *toppath* "/db/main.db")) *last-db-update-time*))
  (> (file-modification-time *db-file-path* *last-db-update-time*)))

(define (dashboard:set-db-update-time)
  (set! *last-db-update-time* (file-modification-time (conc *toppath* "/db/main.db"))))
  (set! *last-db-update-time* (file-modification-time *db-file-path*)))

(define (dashboard:recalc modtime please-update-buttons last-db-update-time)
  (or please-update-buttons
      (and (> (current-milliseconds)(+ *last-recalc-ended-time* 150))
	   (> modtime last-db-update-time)
	   (> (current-seconds)(+ last-db-update-time 1)))))

(define *monitor-db-path* (conc *toppath* "/db/monitor.db"))
(define *monitor-db-path* (conc *dbdir* "/monitor.db"))
(define *last-monitor-update-time* 0)

;; Force creation of the db in case it isn't already there.
(let ((db (tasks:open-db)))
  (sqlite3:finalize! db))

(define (dashboard:get-youngest-run-db-mod-time)
  (apply max (map (lambda (filen)
		    (file-modification-time filen))
		  (glob (conc *toppath* "/db/*.db")))))
		  (glob (conc *dbdir* "/*.db")))))

(define (dashboard:run-update x)
  (let* ((modtime         (dashboard:get-youngest-run-db-mod-time)) ;; (file-modification-time *db-file-path*))
	 (monitor-modtime (file-modification-time *monitor-db-path*))
	 (run-update-time (current-seconds))
	 (recalc          (dashboard:recalc modtime *please-update-buttons* *last-db-update-time*)))
    (if (and (eq? *current-tab-number* 0)