Overview
Comment: | fixed-fork |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-revolution |
Files: | files | file ages | folders |
SHA1: |
1e9f9c66b3b0273151b336061af217f8 |
User & Date: | mrwellan on 2024-01-19 08:53:12 |
Other Links: | branch diff | manifest | tags |
Context
2024-02-02
| ||
20:00 | updated version to 1.8029 Leaf check-in: 2c34bbfead user: mmgraham tags: v1.8029 | |
2024-01-19
| ||
22:10 | guarded against empty run name and no target selected in Run Control. check-in: 3947694200 user: mmgraham tags: v1.80-revolution | |
08:53 | fixed-fork check-in: 1e9f9c66b3 user: mrwellan tags: v1.80-revolution | |
08:51 | To deal with bash vs csh stupidity use current-directory instead of PWD since the logical path is lost in most cases causing issues in finding db files. check-in: f9d63f34c4 user: mrwellan tags: v1.80-revolution | |
2024-01-18
| ||
23:10 | updated server start message check-in: 6248485505 user: mmgraham tags: v1.80-revolution | |
Changes
Modified dashboard.scm from [ff41a61c9e] to [d070a63110].
︙ | ︙ | |||
751 752 753 754 755 756 757 | (dboard:rundat-run-data-offset-set! run-dat (+ num-to-get (dboard:rundat-run-data-offset run-dat))))) (for-each (lambda (tdat) (let ((test-id (db:test-get-id tdat)) (state (db:test-get-state tdat))) | | | | | | | | 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 | (dboard:rundat-run-data-offset-set! run-dat (+ num-to-get (dboard:rundat-run-data-offset run-dat))))) (for-each (lambda (tdat) (let ((test-id (db:test-get-id tdat)) (state (db:test-get-state tdat))) (dboard:rundat-data-changed-set! run-dat #t) (if (equal? state "DELETED") (hash-table-delete! tests-ht test-id) (hash-table-set! tests-ht test-id tdat)))) tmptests) tests-ht)) ;; tmptests - new tests data ;; prev-tests - old tests data ;; ;; (define (dashboard:merge-changed-tests tabdat tests tmptests) ;; use-new prev-tests) ;; (let* ((newdat (filter |
︙ | ︙ | |||
901 902 903 904 905 906 907 | (let loop ((run (car runs)) (tal (cdr runs)) (res '()) (maxtests 0) (cont-run #f)) (let* ((run-id (db:get-value-by-header run header "id")) (recently-done (< (- (current-seconds) | | | 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 | (let loop ((run (car runs)) (tal (cdr runs)) (res '()) (maxtests 0) (cont-run #f)) (let* ((run-id (db:get-value-by-header run header "id")) (recently-done (< (- (current-seconds) (hash-table-ref/default *dashboard-last-run-id-update* run-id 0)) 1)) (run-struct (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f)) ;; (last-update (if run-struct (dboard:rundat-last-update run-struct) 0)) (key-vals (rmt:get-key-vals run-id)) (tests-ht (let* ((tht (if (and recently-done run-struct) (let ((rht (dboard:rundat-tests run-struct))) ;; (dboard:tabdat-allruns-by-id tabdat))) (or rht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))) |
︙ | ︙ | |||
941 942 943 944 945 946 947 | (lambda (a b) (eq? (db:get-value-by-header (dboard:rundat-run a) header "id") (db:get-value-by-header (dboard:rundat-run b) header "id")))))) (elapsed-time (- (current-seconds) start-time))) (if (null? all-test-ids) (hash-table-delete! (dboard:tabdat-allruns-by-id tabdat) run-id) (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id run-struct)) | | | 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 | (lambda (a b) (eq? (db:get-value-by-header (dboard:rundat-run a) header "id") (db:get-value-by-header (dboard:rundat-run b) header "id")))))) (elapsed-time (- (current-seconds) start-time))) (if (null? all-test-ids) (hash-table-delete! (dboard:tabdat-allruns-by-id tabdat) run-id) (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id run-struct)) (if (or (null? tal) (> elapsed-time 2)) ;; stop loading data after 5 ;; seconds, on the next call ;; more data *should* be ;; loaded since ;; get-tests-for-run uses last ;; update |
︙ | ︙ | |||
1180 1181 1182 1183 1184 1185 1186 | tabdat (let ((xl (if (> (length (dboard:tabdat-all-test-names tabdat)) (dboard:tabdat-start-test-offset tabdat)) (drop (dboard:tabdat-all-test-names tabdat) (dboard:tabdat-start-test-offset tabdat)) '()))) (append xl (make-list (- (dboard:tabdat-num-tests tabdat) (length xl)) "")))) (update-labels uidat (dboard:tabdat-all-test-names tabdat)) | | < > | | < | < < < < < | 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 | tabdat (let ((xl (if (> (length (dboard:tabdat-all-test-names tabdat)) (dboard:tabdat-start-test-offset tabdat)) (drop (dboard:tabdat-all-test-names tabdat) (dboard:tabdat-start-test-offset tabdat)) '()))) (append xl (make-list (- (dboard:tabdat-num-tests tabdat) (length xl)) "")))) (update-labels uidat (dboard:tabdat-all-test-names tabdat)) (for-each ;;run (lambda (rundat) (if (or (not rundat) ;; handle padded runs (not (dboard:rundat-run rundat))) ;; Need to put an empty column in to erase previous contents. (set! rundat (dboard:rundat-make-init key-vals: (map (lambda (x) "")(dboard:tabdat-keys tabdat))))) (let* ((run (dboard:rundat-run rundat)) (testsdat-by-name (dboard:rundat-tests-by-name rundat)) (key-val-dat (dboard:rundat-key-vals rundat)) (run-id (db:get-value-by-header run (dboard:tabdat-header tabdat) "id")) (key-vals (append key-val-dat (list (let ((x (db:get-value-by-header run (dboard:tabdat-header tabdat) "runname"))) (if (string? x) x ""))))) (run-key (string-intersperse key-vals "\n"))) ;; fill in the run header key values ;; (let ((rown 0) (headercol (vector-ref tableheader coln))) (for-each (lambda (kval) (let* ((labl (vector-ref headercol rown))) (if (not (equal? kval (iup:attribute labl "TITLE"))) (iup:attribute-set! (vector-ref headercol rown) "TITLE" kval)) (set! rown (+ rown 1)))) key-vals)) ;; For this run now fill in the buttons for each test ;; (let ((rown 0) (columndat (vector-ref table coln))) (for-each (lambda (testname) (let ((buttondat (hash-table-ref/default (dboard:tabdat-buttondat tabdat) (mkstr coln rown) #f))) (if (and buttondat (hash-table? testsdat-by-name)) (let* ((testdat (let ((matching (hash-table-ref/default testsdat-by-name testname #f))) ;; (filter ;; (lambda (x)(equal? (test:test-get-fullname x) testname)) ;; testsdat))) (if (not matching) (vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "") ;; (car matching)))) matching))) (teststatus (db:test-get-status testdat)) (teststate (db:test-get-state testdat)) (buttontxt (cond ((member teststate '("COMPLETED" "ARCHIVED")) teststatus) ((and (equal? teststate "NOT_STARTED") (member teststatus '("ZERO_ITEMS" "BLOCKED" "PREQ_FAIL" "PREQ_DISCARDED" "TIMED_OUT" "KEEP_TRYING" "TEN_STRIKES"))) teststatus) (else teststate))) |
︙ | ︙ | |||
3166 3167 3168 3169 3170 3171 3172 | (define (dboard:set-last-db-update! tabdat context newtime) (hash-table-set! (dboard:tabdat-last-db-update tabdat) context newtime)) ;; (define (dashboard:database-changed? commondat tabdat #!key (context-key 'default)) (let* ((run-update-time (current-seconds)) | | | 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 | (define (dboard:set-last-db-update! tabdat context newtime) (hash-table-set! (dboard:tabdat-last-db-update tabdat) context newtime)) ;; (define (dashboard:database-changed? commondat tabdat #!key (context-key 'default)) (let* ((run-update-time (current-seconds)) (dbdir (conc *toppath* "/.mtdb")) (modtime (dashboard:get-youngest-run-db-mod-time dbdir)) (recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:get-last-db-update tabdat context-key)))) (if recalc (dboard:set-last-db-update! tabdat context-key run-update-time)) (dboard:commondat-please-update-set! commondat #f) |
︙ | ︙ |
Modified dbmod.scm from [404c8ee706] to [4cd67b59a2].
︙ | ︙ | |||
897 898 899 900 901 902 903 | ;; (define *dbstruct-dbs* #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this. ;; db stats (define *db-stats* (make-hash-table)) ;; hash of vectors < count duration-total > (define *db-stats-mutex* (make-mutex)) (define (rmt:print-db-stats) | | | | 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 | ;; (define *dbstruct-dbs* #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this. ;; db stats (define *db-stats* (make-hash-table)) ;; hash of vectors < count duration-total > (define *db-stats-mutex* (make-mutex)) (define (rmt:print-db-stats) (let ((fmtstr "~40a~8-d~20-d~20,2-f")) ;; "~20,2-f" (debug:print 0 *default-log-port* "DB Stats\n========") (debug:print 0 *default-log-port* (format #f "~40a~8a~20a~10a" "Cmd" "Count" "TotTime" "Avg")) (for-each (lambda (cmd) (let* ((dat (hash-table-ref *db-stats* cmd)) (count (dbstat-cnt dat)) (tottime (dbstat-tottime dat))) (debug:print 0 *default-log-port* (format #f fmtstr cmd count tottime (/ tottime count))))) |
︙ | ︙ |
Modified megatest.scm from [02fbabd339] to [5f91080744].
︙ | ︙ | |||
970 971 972 973 974 975 976 | (let* (;; (run-id (args:get-arg "-run-id")) (dbfname (args:get-arg "-db")) (tl (launch:setup)) (keys (keys:config-get-fields *configdat*))) (case (rmt:transport-mode) ((tcp) (let* ((timeout (server:expiration-timeout))) | | | 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 | (let* (;; (run-id (args:get-arg "-run-id")) (dbfname (args:get-arg "-db")) (tl (launch:setup)) (keys (keys:config-get-fields *configdat*))) (case (rmt:transport-mode) ((tcp) (let* ((timeout (server:expiration-timeout))) (debug:print 0 *default-log-port* "INFO: megatest -server starting on " (get-host-name) " for " dbfname " using tcp method with timeout of "timeout) (tt-server-timeout-param timeout) (thread-start! (make-thread api:print-db-stats "print-db-stats")) (if dbfname (tt:start-server tl #f dbfname api:tcp-dispatch-request-make-handler keys) (begin (debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -db is required.") (exit 1))))) |
︙ | ︙ |