Megatest

Changes On Branch ab0d1e763345f18d
Login

Changes In Branch v1.60-zero-local-access Through [ab0d1e7633] Excluding Merge-Ins

This is equivalent to a diff from ab348d3b46 to ab0d1e7633

2015-11-12
14:11
Be more lazy on running sync to megatest.db check-in: 27552d9089 user: mrwellan tags: v1.60
2015-11-11
23:00
Merging in v1.60-zero-local-access to v1.60 Closed-Leaf check-in: c6c921401e user: matt tags: v1.60-zero-local-access
22:28
Added back sync'ing to megatest.db but with simple file locking and much longer delay check-in: 29908b23ed user: matt tags: v1.60-zero-local-access
20:50
Merged in recent changes to v1.60 in prep for meld check-in: ab0d1e7633 user: matt tags: v1.60-zero-local-access
20:47
All states supported now check-in: ab348d3b46 user: matt tags: v1.60
20:47
Fix typo Closed-Leaf check-in: 56036da5c4 user: matt tags: launcher-exit-handling-refactor
11:27
Merged logpro-abort-check into v1.60/28 but abort not quite right yet check-in: b6900f572f user: mrwellan tags: v1.60
2015-11-05
04:16
Convert get run stats to NOT use local access, ALL db busy checks hard turned off check-in: ffdb01323d user: matt tags: v1.60-zero-local-access

Modified api.scm from [7425d00411] to [d2df3c2dd1].

214
215
216
217
218
219
220

221
222
223
224
225
226
227
	    ((get-runs)                     (apply db:get-runs dbstruct params))
	    ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
	    ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
	    ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
	    ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
	    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
	    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))


	    ;; STEPS
	    ((get-steps-data)               (apply db:get-steps-data dbstruct params))
	    ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))

	    ;; MISC
	    ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))







>







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
	    ((get-runs)                     (apply db:get-runs dbstruct params))
	    ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
	    ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
	    ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
	    ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
	    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
	    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
	    ((get-run-stats)                (apply db:get-run-stats dbstruct params))

	    ;; STEPS
	    ((get-steps-data)               (apply db:get-steps-data dbstruct params))
	    ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))

	    ;; MISC
	    ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))

Modified dashboard.scm from [3d081ca889] to [7bcb6b3970].

88
89
90
91
92
93
94
95


96
97
98
99
100
101
102
103
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

(define *useserver* (or(not (args:get-arg "-use-local"))
			(configf:lookup *configdat* "dashboard" "use-server")))

(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(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? *db-file-path*)))

(define toplevel #f)
(define dlg      #f)







|
>
>
|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

(define *useserver* (or(not (args:get-arg "-use-local"))
			(configf:lookup *configdat* "dashboard" "use-server")))

(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbstruct-local*  (if *useserver*
			      #f
			      (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? *db-file-path*)))

(define toplevel #f)
(define dlg      #f)

Modified db.scm from [3b21c0f4f0] to [a67df6fe11].

1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
	"SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;")
    (reverse run-ids)))))

;; get some basic run stats
;;
;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats dbstruct)
  (let* ((dbdat        (db:get-db dbstruct #f))
	 (db           (db:dbdat-get-db dbdat))
	 (totals       (make-hash-table))
	 (curr         (make-hash-table))
	 (res          '())
	 (runs-info    '()))
    ;; First get all the runname/run-ids
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row
     (lambda (run-id runname)
       (set! runs-info (cons (list run-id runname) runs-info)))
     db
     "SELECT id,runname FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;") ;; If you change this to the more logical ASC please adjust calls to db:get-run-stats
    ;; for each run get stats data
    (for-each
     (lambda (run-info)
       ;; get the net state/status counts for this run
       (let* ((run-id   (car  run-info))
	      (run-name (cadr run-info)))
	 (db:with-db
	  dbstruct
	  run-id
	  #f
	  (lambda (db)
	    (sqlite3:for-each-row
	     (lambda (state status count)
	       (let ((netstate (if (equal? state "COMPLETED") status state)))
		 (if (string? netstate)
		     (begin
		       (hash-table-set! totals netstate (+ (hash-table-ref/default totals netstate 0) count))
		       (hash-table-set! curr   netstate (+ (hash-table-ref/default curr   netstate 0) count))))))
	     db
	     "SELECT state,status,count(id) FROM tests AS t GROUP BY state,status ORDER BY state,status DESC;")
	    ;; add the per run counts to res
	    (for-each (lambda (state)
			(set! res (cons (list run-name state (hash-table-ref curr state)) res)))
		      (sort (hash-table-keys curr) string>=))
	    (set! curr (make-hash-table))))))
     runs-info)
    (for-each (lambda (state)
		(set! res (cons (list "Totals" state (hash-table-ref totals state)) res)))
	      (sort (hash-table-keys totals) string>=))
    res))

;; db:get-runs-by-patt
;; get runs by list of criteria







|
|






|
<
<
<
<
<
<
<
<
<
<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<







1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835











1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854

1855
1856
1857
1858
1859
1860
1861
	"SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;")
    (reverse run-ids)))))

;; get some basic run stats
;;
;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats dbstruct run-id run-name)
  (let* ((dbdat        (db:get-db dbstruct run-id))
	 (db           (db:dbdat-get-db dbdat))
	 (totals       (make-hash-table))
	 (curr         (make-hash-table))
	 (res          '())
	 (runs-info    '()))
    ;; First get all the runname/run-ids
    ;; (db:delay-if-busy dbdat)











    (db:with-db
     dbstruct
     run-id
     #f
     (lambda (db)
       (sqlite3:for-each-row
	(lambda (state status count)
	  (let ((netstate (if (equal? state "COMPLETED") status state)))
	    (if (string? netstate)
		(begin
		  (hash-table-set! totals netstate (+ (hash-table-ref/default totals netstate 0) count))
		  (hash-table-set! curr   netstate (+ (hash-table-ref/default curr   netstate 0) count))))))
	db
	"SELECT state,status,count(id) FROM tests AS t GROUP BY state,status ORDER BY state,status DESC;")
       ;; add the per run counts to res
       (for-each (lambda (state)
		   (set! res (cons (list run-name state (hash-table-ref curr state)) res)))
		 (sort (hash-table-keys curr) string>=))
       (set! curr (make-hash-table))))

    (for-each (lambda (state)
		(set! res (cons (list "Totals" state (hash-table-ref totals state)) res)))
	      (sort (hash-table-keys totals) string>=))
    res))

;; db:get-runs-by-patt
;; get runs by list of criteria
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
			   (hash-table-set! tests-hash full-testname testdat))))
		   results)
		  (if (null? tal)
		      (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
		      (loop (car tal)(cdr tal))))))))))

(define (db:delay-if-busy dbdat #!key (count 6))
  (if (not (configf:lookup *configdat* "server" "delay-on-busy"))
      (and dbdat (db:dbdat-get-db dbdat))
      (if dbdat
	  (let* ((dbpath (db:dbdat-get-path dbdat))
		 (db     (db:dbdat-get-db   dbdat)) ;; we'll return this so (db:delay--if-busy can be called inline
		 (dbfj   (conc dbpath "-journal")))
	    (if (handle-exceptions
		 exn







|







3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
			   (hash-table-set! tests-hash full-testname testdat))))
		   results)
		  (if (null? tal)
		      (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
		      (loop (car tal)(cdr tal))))))))))

(define (db:delay-if-busy dbdat #!key (count 6))
  (if #f ;; (not (configf:lookup *configdat* "server" "delay-on-busy"))
      (and dbdat (db:dbdat-get-db dbdat))
      (if dbdat
	  (let* ((dbpath (db:dbdat-get-path dbdat))
		 (db     (db:dbdat-get-db   dbdat)) ;; we'll return this so (db:delay--if-busy can be called inline
		 (dbfj   (conc dbpath "-journal")))
	    (if (handle-exceptions
		 exn

Modified dcommon.scm from [5d1caffec5] to [f2eb55f8d3].

398
399
400
401
402
403
404
405


406
407
408
409
410
411
412

    general-matrix))

(define (dcommon:run-stats dbstruct)
  (let* ((stats-matrix (iup:matrix expand: "YES"))
	 (changed      #f)
	 (updater      (lambda ()
			 (let* ((run-stats    (db:get-run-stats dbstruct))


				(indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
				(row-indices  (car indices))
				(col-indices  (cadr indices))
				(max-row      (if (null? row-indices) 1 (apply max (map cadr row-indices))))
				(max-col      (if (null? col-indices) 1 
						  (apply max (map cadr col-indices))))
				(max-visible  (max (- *num-tests* 15) 3))







|
>
>







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414

    general-matrix))

(define (dcommon:run-stats dbstruct)
  (let* ((stats-matrix (iup:matrix expand: "YES"))
	 (changed      #f)
	 (updater      (lambda ()
			 (let* ((run-stats    (if dbstruct
						  (db:get-run-stats dbstruct)
						  (rmt:get-all-run-stats)))
				(indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
				(row-indices  (car indices))
				(col-indices  (cadr indices))
				(max-row      (if (null? row-indices) 1 (apply max (map cadr row-indices))))
				(max-col      (if (null? col-indices) 1 
						  (apply max (map cadr col-indices))))
				(max-visible  (max (- *num-tests* 15) 3))

Modified megatest.scm from [47f4506230] to [a6b3a87608].

325
326
327
328
329
330
331

332
333
334
335
336
337
338
339
(define *watchdog*
  (make-thread 
   (lambda ()
     (thread-sleep! 0.05) ;; delay for startup
     (let ((legacy-sync (common:legacy-sync-required))
	   (debug-mode  (debug:debug-mode 1))
	   (last-time   (current-seconds)))

       (if (common:legacy-sync-recommended)
	   (let loop ()
	     ;; sync for filesystem local db writes
	     ;;
	     (let ((start-time      (current-seconds))
		   (servers-started (make-hash-table)))
	       (for-each 
		(lambda (run-id)







>
|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
(define *watchdog*
  (make-thread 
   (lambda ()
     (thread-sleep! 0.05) ;; delay for startup
     (let ((legacy-sync (common:legacy-sync-required))
	   (debug-mode  (debug:debug-mode 1))
	   (last-time   (current-seconds)))
       (if legacy-sync
	;;	(common:legacy-sync-recommended))
	   (let loop ()
	     ;; sync for filesystem local db writes
	     ;;
	     (let ((start-time      (current-seconds))
		   (servers-started (make-hash-table)))
	       (for-each 
		(lambda (run-id)

Modified rmt.scm from [58033889c8] to [1253a2efe8].

620
621
622
623
624
625
626




















627
628
629
630
631
632
633
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      (if (null? results) #f
			  (car results))))))))))





















;;======================================================================
;;  S T E P S
;;======================================================================

;; Getting steps is more complicated.
;;
;; If given work area 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      (if (null? results) #f
			  (car results))))))))))

;; call with run-id #f
;;
(define (rmt:get-all-run-stats)
  (let* ((runs-dat (rmt:get-runs "%" #f #f '()))
	 (header   (db:get-header runs-dat))
	 (runs     (db:get-rows   runs-dat)))
    (fold (lambda (run currdat)
	    (let* ((run-id   (db:get-value-by-header run header "id"))
		   (run-name (db:get-value-by-header run header "runname")))
	      (if (and run-id run-name)
		  (append (rmt:get-run-stats run-id run-name) currdat)
		  (begin
		    (debug:print 0 "ERROR: Bad run-id or run-name in " run)
		    currdat))))
	  '()
	  runs)))

(define (rmt:get-run-stats run-id run-name)
  (rmt:send-receive 'get-run-stats run-id (list run-id run-name)))

;;======================================================================
;;  S T E P S
;;======================================================================

;; Getting steps is more complicated.
;;
;; If given work area