Megatest

Check-in [89ffda5553]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-fixes
Files: files | file ages | folders
SHA1: 89ffda5553ac234795a1137d932896f180628689
User & Date: matt on 2020-02-26 15:08:55
Other Links: branch diff | manifest | tags
Context
2020-02-29
16:07
Beginnings of update of runs tree check-in: bcd244a86b user: matt tags: v1.65-fixes
2020-02-26
15:08
wip check-in: 89ffda5553 user: matt tags: v1.65-fixes
2020-02-25
15:03
wip check-in: 37b527f2ee user: matt tags: v1.65-fixes
Changes

Modified dashboard.scm from [bb9e5baee5] to [5b78fda6a2].

2561
2562
2563
2564
2565
2566
2567
































2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
				      (mark-for-update tabdat)
				      (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
				      (iup:attribute-set! obj "MAX" (* maxruns 10))))
		#:expand "HORIZONTAL"
		#:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10))
		#:min 0
		#:step 0.01))

































(define (new-runs-updater commondat rdat)
  (let* ((last-update       (dboard:rdat-last-update     rdat))
	 (targ-sql-filt    (dboard:rdat-targ-sql-filt    rdat))
	 (runname-sql-filt (dboard:rdat-runname-sql-filt rdat))
	 (state-sql-filt   (dboard:rdat-state-sql-filt   rdat))
	 (status-sql-filt  (dboard:rdat-status-sql-filt  rdat))
	 ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
	 (newrunsdata      (rmt:get-runs-by-patt (dboard:rdat-keys rdat)
						 (or targ-sql-filt "%")
						 #f #f #f #f last-update)))
    (print "newrunsdata: " newrunsdata)
    (dboard:rdat-last-update-set! rdat (- (current-seconds) 10))
    '()))
	 
(define (make-runs-view commondat rdat tab-num)
  ;; register an updater
  (dboard:commondat-add-updater
   commondat







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








<
|
|
<







2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607

2608
2609

2610
2611
2612
2613
2614
2615
2616
				      (mark-for-update tabdat)
				      (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
				      (iup:attribute-set! obj "MAX" (* maxruns 10))))
		#:expand "HORIZONTAL"
		#:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10))
		#:min 0
		#:step 0.01))

;; make-simple-run                   procedure (target3772 id3773 runname3774 state3775 status3776 owner3777 event_time3778)
;; rmt:simple-get-runs               procedure (runpatt1001 count1002 offset1003 target1004)
;; simple-run-event_time             procedure (x3834)
;; simple-run-event_time-set!        procedure (x3830 val3831)
;; simple-run-id                     procedure (x3794)
;; simple-run-id-set!                procedure (x3790 val3791)
;; simple-run-owner                  procedure (x3826)
;; simple-run-owner-set!             procedure (x3822 val3823)
;; simple-run-runname                procedure (x3802)
;; simple-run-runname-set!           procedure (x3798 val3799)
;; simple-run-state                  procedure (x3810)
;; simple-run-state-set!             procedure (x3806 val3807)
;; simple-run-status                 procedure (x3818)
;; simple-run-status-set!            procedure (x3814 val3815)
;; simple-run-target                 procedure (x3786)
;; simple-run-target-set!            procedure (x3782 val3783)
;; simple-run?                       procedure (x3780)

;; runs is <vec header runs>
;;
(define (dashboard:update-runs-data data rdat)
  ;; update runs       id              => runrec
  ;; update targ-runid target/runname  => run-id
  (for-each
   (lambda (runrec)
     (let* ((run-id (simple-run-id runrec)))
       (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec)
       (hash-table-set! (dboard:rdat-targ-runid rdat)
			(conc (simple-run-target runrec) "/" (simple-run-runname runrec))
			run-id)))
   data))

(define (new-runs-updater commondat rdat)
  (let* ((last-update       (dboard:rdat-last-update     rdat))
	 (targ-sql-filt    (dboard:rdat-targ-sql-filt    rdat))
	 (runname-sql-filt (dboard:rdat-runname-sql-filt rdat))
	 (state-sql-filt   (dboard:rdat-state-sql-filt   rdat))
	 (status-sql-filt  (dboard:rdat-status-sql-filt  rdat))
	 ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))

	 (newdata          (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt last-update)))
    (dashboard:update-runs-data newdata rdat)

    (dboard:rdat-last-update-set! rdat (- (current-seconds) 10))
    '()))
	 
(define (make-runs-view commondat rdat tab-num)
  ;; register an updater
  (dboard:commondat-add-updater
   commondat

Modified db.scm from [8a077942c3] to [f22e159a5f].

2024
2025
2026
2027
2028
2029
2030




2031
2032
2033
2034
2035
2036
2037
		       (lambda (key)
			 (set! res (cons key res)))
		       db
		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
	(set! *db-keys* res)
	res)))





;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (if (or (null? header) (not row))
      #f
      (let loop ((hed (car header))
                 (tal (cdr header))
                 (n   0))







>
>
>
>







2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
		       (lambda (key)
			 (set! res (cons key res)))
		       db
		       "SELECT fieldname FROM keys ORDER BY id DESC;")))
	(set! *db-keys* res)
	res)))

;; extract index number given a header/data structure
(define (db:get-index-by-header header field)
  (list-index (lambda (x)(equal? x field)) header))

;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (if (or (null? header) (not row))
      #f
      (let loop ((hed (car header))
                 (tal (cdr header))
                 (n   0))
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228




2229
2230
2231
2232
2233
2234

2235
2236
2237
2238
2239
2240
2241
(define-record simple-run target id runname state status owner event_time)
(define-record-printer (simple-run x out)
  (fprintf out "#,(simple-run ~S ~S ~S ~S)"
	   (simple-run-target x) (simple-run-id x) (simple-run-runname x) (time->string (seconds->local-time (simple-run-event_time x) ))))

;; simple get-runs
;;
(define (db:simple-get-runs dbstruct runpatt count offset target)
    (let* ((res       '())
	   (keys       (db:get-keys dbstruct))
	   (runpattstr (db:patt->like "runname" runpatt))
	   (remfields  (list "id" "runname" "state" "status" "owner" "event_time"))
	   (targstr    (string-intersperse keys "||'/'||"))
	   (keystr     (conc targstr " AS target,"
			     (string-intersperse remfields ",")))
	   (qrystr     (conc "SELECT " keystr " FROM runs WHERE (" runpattstr ") " ;; runname LIKE ? "
			     ;; Generate: " AND x LIKE 'keypatt' ..."
			     " AND target LIKE '" target "'"
			     " AND state != 'deleted' ORDER BY event_time DESC "




			     (if (number? count)
				 (conc " LIMIT " count)
				 "")
			     (if (number? offset)
				 (conc " OFFSET " offset)
				 ""))))

    (debug:print-info 11 *default-log-port* "db:get-runs START qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
    (db:with-db dbstruct #f #f
		(lambda (db)		
		  (sqlite3:for-each-row
		   (lambda (target id runname state status owner event_time)
		     (set! res (cons (make-simple-run target id runname state status owner event_time) res)))
		   db







|










|
>
>
>
>





|
>







2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
(define-record simple-run target id runname state status owner event_time)
(define-record-printer (simple-run x out)
  (fprintf out "#,(simple-run ~S ~S ~S ~S)"
	   (simple-run-target x) (simple-run-id x) (simple-run-runname x) (time->string (seconds->local-time (simple-run-event_time x) ))))

;; simple get-runs
;;
(define (db:simple-get-runs dbstruct runpatt count offset target last-update)
    (let* ((res       '())
	   (keys       (db:get-keys dbstruct))
	   (runpattstr (db:patt->like "runname" runpatt))
	   (remfields  (list "id" "runname" "state" "status" "owner" "event_time"))
	   (targstr    (string-intersperse keys "||'/'||"))
	   (keystr     (conc targstr " AS target,"
			     (string-intersperse remfields ",")))
	   (qrystr     (conc "SELECT " keystr " FROM runs WHERE (" runpattstr ") " ;; runname LIKE ? "
			     ;; Generate: " AND x LIKE 'keypatt' ..."
			     " AND target LIKE '" target "'"
			     " AND state != 'deleted' "
			     (if (number? last-update)
				 (conc " AND last_update >= " last-update)
				 "")
			     " ORDER BY event_time DESC "
			     (if (number? count)
				 (conc " LIMIT " count)
				 "")
			     (if (number? offset)
				 (conc " OFFSET " offset)
				 "")))
	   )
    (debug:print-info 11 *default-log-port* "db:get-runs START qrystr: " qrystr " target: " target " offset: " offset " limit: " count)
    (db:with-db dbstruct #f #f
		(lambda (db)		
		  (sqlite3:for-each-row
		   (lambda (target id runname state status owner event_time)
		     (set! res (cons (make-simple-run target id runname state status owner event_time) res)))
		   db

Modified rmt.scm from [8c67a7dcdf] to [08548046ca].

733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records #f '()))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:simple-get-runs runpatt count offset target)
  (rmt:send-receive 'simple-get-runs #f (list runpatt count offset target)))

(define (rmt:get-all-run-ids)
  (rmt:send-receive 'get-all-run-ids #f '()))

(define (rmt:get-prev-run-ids run-id)
  (rmt:send-receive 'get-prev-run-ids #f (list run-id)))








|
|







733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records #f '()))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:simple-get-runs runpatt count offset target last-update)
  (rmt:send-receive 'simple-get-runs #f (list runpatt count offset target last-update)))

(define (rmt:get-all-run-ids)
  (rmt:send-receive 'get-all-run-ids #f '()))

(define (rmt:get-prev-run-ids run-id)
  (rmt:send-receive 'get-prev-run-ids #f (list run-id)))

Modified runs.scm from [650378342c] to [1277a2dbd4].

2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
;;
(define (runs:get-hash-by-target target-patts runpatt)
  (let* ((targets (string-split target-patts ","))
	 (keys    (rmt:get-keys))
	 (res-ht  (make-hash-table))) ;; target -> ( runrecord1 runrecord2 ... )
    (for-each
     (lambda (target-patt)
       (let ((runs     (rmt:simple-get-runs runpatt #f #f target-patt)))
	 (for-each
	  (lambda (run)
	    (let ((target (simple-run-target run)))
	      (hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
	  runs)))
     targets)
    res-ht))







|







2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
;;
(define (runs:get-hash-by-target target-patts runpatt)
  (let* ((targets (string-split target-patts ","))
	 (keys    (rmt:get-keys))
	 (res-ht  (make-hash-table))) ;; target -> ( runrecord1 runrecord2 ... )
    (for-each
     (lambda (target-patt)
       (let ((runs     (rmt:simple-get-runs runpatt #f #f target-patt #f)))
	 (for-each
	  (lambda (run)
	    (let ((target (simple-run-target run)))
	      (hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
	  runs)))
     targets)
    res-ht))