Megatest

Check-in [3f669a2c30]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Got basic newdashboard functionality back
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 3f669a2c30fc7cd1d73e2df552659d214aab48dc
User & Date: matt on 2014-12-27 23:44:53
Other Links: branch diff | manifest | tags
Context
2014-12-29
15:57
Fixed typo check-in: a1dfc62a4e user: mrwellan tags: v1.60
2014-12-28
18:39
Removing reliance on globals in prep for multi-testsuite support in dashboard check-in: f8db475db1 user: matt tags: multi-testsuite-support
2014-12-27
23:44
Got basic newdashboard functionality back check-in: 3f669a2c30 user: matt tags: v1.60
2014-12-23
23:20
sketched out restore check-in: d36fddcc33 user: matt tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified api.scm from [502389005b] to [030af4fe6b].

︙
45
46
47
48
49
50
51

52
53
54
55
56
57
58

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59








+








    get-prev-run-ids
    get-run-ids-matching-target
    get-runs-by-patt
    get-steps-data
    login
    testmeta-get-record
    have-incompletes?
    synchash-get
    ))

(define api:write-queries
  '(
    ;; SERVERS
    start-server
    kill-server
︙
186
187
188
189
190
191
192

193
194
195
196
197
198
199

187
188
189
190
191
192
193
194
195
196
197
198
199
200
201








+








	    ((test-get-logfile-info)           (apply db:test-get-logfile-info dbstruct params))
	    ((test-get-records-for-index-file)  (apply db:test-get-records-for-index-file dbstruct params))
	    ((get-testinfo-state-status)       (apply db:get-testinfo-state-status dbstruct params))
	    ((test-get-top-process-pid)        (apply db:test-get-top-process-pid dbstruct params))
	    ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
	    ((get-prereqs-not-met)             (apply db:get-prereqs-not-met dbstruct params))
	    ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
	    ((synchash-get)                    (apply synchash:server-get dbstruct params))

	    ;; RUNS
	    ((get-run-info)                 (apply db:get-run-info dbstruct params))
	    ((get-run-status)               (apply db:get-run-status dbstruct params))
	    ((set-run-status)               (apply db:set-run-status dbstruct params))
	    ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
	    ((get-test-id)                  (apply db:get-test-id dbstruct params))
︙

Modified dcommon.scm from [cd3454dabd] to [ea99b44dfd].

︙
134
135
136
137
138
139
140
141
142


143
144
145
146
147
148
149
150



151



152
153
154
155
156
157
158

134
135
136
137
138
139
140


141
142
143
144
145
146
147
148
149
150
151
152
153

154
155
156
157
158
159
160
161
162
163








-
-
+
+








+
+
+
-
+
+
+








	 ;; the synchash calls modify the "data" hash
	 (get-runs-sig    (conc (client:get-signature) " get-runs"))
	 (get-tests-sig   (conc (client:get-signature) " get-tests"))
	 (get-details-sig (conc (client:get-signature) " get-test-details"))

	 ;; test-ids to get and display are indexed on window-id in curr-test-ids hash
	 (test-ids        (hash-table-values (dboard:data-get-curr-test-ids *data*)))

 	 (run-changes     (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data runname #f #f keypatts))
	 ;; run-id is #f in next line to send the query to server 0
 	 (run-changes     (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts))
	 (tests-detail-changes (if (not (null? test-ids))
				   (synchash:client-get 'db:get-test-info-by-ids get-details-sig 0  data #f test-ids)
				   '()))

	 ;; Now can calculate the run-ids
	 (run-hash    (hash-table-ref/default data get-runs-sig #f))
	 (run-ids     (if run-hash (filter number? (hash-table-keys run-hash)) '()))

	 (all-test-changes (let ((res (make-hash-table)))
			     (for-each (lambda (run-id)
					 (if (> run-id 0)
	 (test-changes (synchash:client-get 'db:get-tests-for-runs-mindata get-tests-sig 0 data run-ids testpatt states statuses #f))
					     (hash-table-set! res run-id (synchash:client-get 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f))))
				       run-ids)
			     res))
	 (runs-hash    (hash-table-ref/default data get-runs-sig #f))
	 (header       (hash-table-ref/default runs-hash "header" #f))
	 (run-ids      (sort (filter number? (hash-table-keys runs-hash))
			     (lambda (a b)
			       (let* ((record-a (hash-table-ref runs-hash a))
				      (record-b (hash-table-ref runs-hash b))
				      (time-a   (db:get-value-by-header record-a header "event_time"))
︙
190
191
192
193
194
195
196

197
198
199
200
201
202
203

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209








+








		  (set! colnum (+ colnum 1))))
	      run-ids)

    ;; Scan all tests to be displayed and organise all the test names, respecting what is in the hash table
    ;; Do this analysis in the order of the run-ids, the most recent run wins
    (for-each (lambda (run-id)
		(let* ((run-path       (hash-table-ref (dboard:data-get-run-keys *data*) run-id))
		       (test-changes   (hash-table-ref all-test-changes run-id))
		       (new-test-dat   (car test-changes))
		       (removed-tests  (cadr test-changes))
		       (tests          (sort (map cadr (filter (lambda (testrec)
								 (eq? run-id (db:mintest-get-run_id (cadr testrec))))
							       new-test-dat))
					     (lambda (a b)
					       (let ((time-a (db:mintest-get-event_time a))
︙
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281

273
274
275
276
277
278
279

280
281
282
283
284
285
286
287








-
+









    (let ((updater (hash-table-ref/default  (dboard:data-get-updaters *data*) window-id #f)))
      (if updater (updater (hash-table-ref/default data get-details-sig #f))))

    (iup:attribute-set! (dboard:data-get-runs-matrix *data*) "REDRAW" "ALL")
    ;; (debug:print 2 "run-changes: " run-changes)
    ;; (debug:print 2 "test-changes: " test-changes)
    (list run-changes test-changes)))
    (list run-changes all-test-changes)))

;;======================================================================
;; TESTS DATA
;;======================================================================

;; Produce a list of lists ready for common:sparse-list-generate-index
;;
︙

Modified launch.scm from [df9137345e] to [c63840475d].

︙
796
797
798
799
800
801
802
803

804
805
806
807
808
809
810

796
797
798
799
800
801
802

803
804
805
806
807
808
809
810








-
+








    (set! mt-bindir-path (pathname-directory remote-megatest))
    (if launcher (set! launcher (string-split launcher)))
    ;; set up the run work area for this test
    (if (and (args:get-arg "-preclean") ;; user has requested to preclean for this run
	     (not (member (db:test-get-rundir testinfo)(list "n/a" "/tmp/badname")))) ;; n/a is a placeholder and thus not a read dir
	(begin
	  (debug:print-info 0 "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path)
	  (runs:remove-test-directory #f testinfo 'remove-data-only))) ;; remove data only, do not perturb the record
	  (runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record

    ;; prevent overlapping actions - set to LAUNCHED as early as possible
    ;;
    (tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
    (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED")
    (set! diskpath (get-best-disk *configdat*))
    (if diskpath
︙

Modified rmt.scm from [3e7f6c01ce] to [6e9129f161].

︙
379
380
381
382
383
384
385




386
387
388
389
390
391
392

379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396








+
+
+
+








  (if (number? run-id)
      (rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals))
      (begin
	(debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id)
	(print-call-chain (current-error-port))
	'())))

;; get stuff via synchash 
(define (rmt:synchash-get run-id proc synckey keynum params)
  (rmt:send-receive 'synchash-get run-id (list run-id proc synckey keynum params)))

;; IDEA: Threadify these - they spend a lot of time waiting ...
;;
(define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
  (let ((multi-run-mutex (make-mutex))
	(run-id-list (if run-ids
			 run-ids
			 (rmt:get-all-run-ids)))
︙

Modified synchash.scm from [9881f5a738] to [67fbbc1d0f].

︙
60
61
62
63
64
65
66
67

68
69

70
71
72
73
74
75
76

60
61
62
63
64
65
66

67


68
69
70
71
72
73
74
75








-
+
-
-
+








    
;; (cdb:remote-run db:get-keys #f)  
;; (cdb:remote-run db:get-num-runs #f "%")
;; (cdb:remote-run db:get-runs #f runnamepatt numruns *start-run-offset* keypatts)
;;
;; keynum => the field to use as the unique key (usually 0 but can be other field)
;;
(define (synchash:client-get proc synckey keynum synchash . params)
(define (synchash:client-get proc synckey keynum synchash run-id . params)
  (let* ((data   ;; (apply cdb:remote-run synchash:server-get #f proc synckey keynum params))
	  (apply synchash:server-get #f proc synckey keynum params))
  (let* ((data   (rmt:synchash-get run-id proc synckey keynum params))
	 (newdat (car data))
	 (removs (cadr data))
	 (myhash (hash-table-ref/default synchash synckey #f)))
    (if (not myhash)
	(begin
	  (set! myhash (make-hash-table))
	  (hash-table-set! synchash synckey myhash)))
︙
87
88
89
90
91
92
93
94

95

96

97
98
99
100

101
102
103
104
105
106
107

86
87
88
89
90
91
92

93
94
95

96
97
98
99

100
101
102
103
104
105
106
107








-
+

+
-
+



-
+








     removs)
    ;; WHICH ONE!?
    ;; data)) ;; return the changed and deleted list
    (list newdat removs))) ;; synchash))

(define *synchashes* (make-hash-table))

(define (synchash:server-get indb proc synckey keynum . params)
(define (synchash:server-get dbstruct run-id proc synckey keynum params)
  ;; (debug:print-info 2 "synckey: " synckey ", keynum: " keynum ", params: " params)
  (let* ((dbdat     (db:get-db dbstruct run-id))
  (let* ((db        (if indb indb (db:open-megatest-db)))
	 (db        (db:dbdat-get-db dbdat))
	 (synchash  (hash-table-ref/default *synchashes* synckey #f))
	 (newdat    (apply (case proc
			     ((db:get-runs)                   db:get-runs)
			     ((db:get-tests-for-runs-mindata) db:get-tests-for-runs-mindata)
			     ((db:get-tests-for-run-mindata)  db:get-tests-for-run-mindata)
			     ((db:get-test-info-by-ids)       db:get-test-info-by-ids)
			     (else
			      (print "ERROR: sync for hash " proc " not setup! Edits needed in synchash.scm")
			      print))
			   db params))
	 (postdat  #f)
	 (make-indexed (lambda (x)
︙

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