Changes In Branch defstruct-srehman Excluding Merge-Ins
This is equivalent to a diff from 481e6c18c6 to abcfb9550d
2016-10-06
| ||
11:28 | Merged partial implementation of graph controls and added remote support for load detection check-in: 18599e811e user: mrwellan tags: v1.62 | |
2016-10-05
| ||
13:34 | merged with latest v1.62 Closed-Leaf check-in: abcfb9550d user: srehman tags: defstruct-srehman | |
13:33 | hardcoded qry-string to typed record check-in: 8ba591abbd user: srehman tags: defstruct-srehman | |
2016-10-03
| ||
16:24 | updated the api doc check-in: 481e6c18c6 user: pjhatwal tags: v1.62 | |
15:49 | Fixed read-only access issues. However it still fails if the db is old (i.e. is missing last_update field). check-in: 7a7ceab729 user: mrwellan tags: v1.62 | |
Modified api.scm from [d744d47aad] to [0846354bc1].
︙ | |||
115 116 117 118 119 120 121 | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | + - + + + + + | (vector #f #f "remote must be called with a vector") (vector ;; return a vector + the returned data structure #t (let ((cmd (vector-ref dat 0)) (params (vector-ref dat 1))) (case (if (symbol? cmd) cmd (if (string? cmd) |
︙ |
Modified dashboard.scm from [a779400c71] to [2dbf5f4194].
︙ | |||
902 903 904 905 906 907 908 | 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 | - + + | (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) |
︙ | |||
1421 1422 1423 1424 1425 1426 1427 | 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 | - - + + | (if (dboard:tabdat-filters-changed tabdat) 0 last-update) *dashboard-mode*) '()))) ;; get 'em all ;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id) (sort tdat (lambda (a b) |
︙ |
Modified db.scm from [7588b62ece] to [25662aed6c].
︙ | |||
2277 2278 2279 2280 2281 2282 2283 | 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 | - + + + + - - - - + - - - - - + + - + - + + | ";" ))) (debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) |
︙ | |||
2592 2593 2594 2595 2596 2597 2598 | 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 | - + - + + + + + | (let* ((dbdat (if (vector? dbstruct) (db:get-db dbstruct run-id) dbstruct)) ;; still settling on when to use dbstruct or dbdat (db (db:dbdat-get-db dbdat)) (res '())) (db:delay-if-busy dbdat) (sqlite3:for-each-row |
︙ | |||
2669 2670 2671 2672 2673 2674 2675 | 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 | - + - + + + + + + - + + - + | (db:with-db dbstruct run-id #f (lambda (db) (let ((res #f)) (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test |
︙ | |||
2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 | 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 | + + + + + + + + + + + - + - - - | ;; foo,bal, 1.2, 1.2, < , ,Check for overload ;; foo,alb, 1.2, 1.2, <= , Amps,This is the high power circuit test ;; foo,abl, 1.2, 1.3, 0.1 ;; foo,bra, 1.2, pass, silly stuff ;; faz,bar, 10, 8mA, , ,"this is a comment" ;; EOF (define (db:csv->list-safe csvdata) (if (string? csvdata) (csv->list (make-csv-reader (open-input-string csvdata) '((strip-leading-whitespace? #t) (strip-trailing-whitespace? #t)))) (begin (debug:print 0 *default-log-port* "ERROR: received non-string data for csv") '()))) (define (db:csv->test-data dbstruct run-id test-id csvdata) (debug:print 4 *default-log-port* "test-id " test-id ", csvdata: " csvdata) (let* ((dbdat (db:get-db dbstruct run-id)) (db (db:dbdat-get-db dbdat)) |
︙ |
Modified db_records.scm from [ebae0b2ffd] to [8b4987b241].
︙ | |||
63 64 65 66 67 68 69 70 | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 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 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 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 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - - - - - - - + + + + + + + - - - - - - - + + + + + + + - - - - - - - + + + + + + + | ;; (define (dbr:dbstruct-localdb v run-id) (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f)) (define (dbr:dbstruct-localdb-set! v run-id db) (hash-table-set! (dbr:dbstruct-locdbs v) run-id db)) (require-extension typed-records) (defstruct db:test-rec ((id -1) : number) ((run_id -1) : number) ((testname "") : string) ((state "") : string) ((status "") : string) ((event_time -1) : number) ((host "") : string) ((cpuload -1) : number) ((diskfree -1) : number) ((uname "") : string) ((rundir "") : string) ((item_path "") : string) ((run_duration -1) : number) ((final_logf "") : string) ((comment "") : string) ((process-id -1) : number) ((archived -1) : number) ((shortdir -1) : number) ((attemptnum -1) : number)) (define (db:qry-gen-alist qrystr listvals) (define listqry (string-split qrystr ",")) (if (null? listqry) '() (let loop ((strhead (car listqry)) (strtail (cdr listqry)) (valhead (car listvals)) (valtail (cdr listvals)) (res '())) (let* ((slot-val-pair (cons (string->symbol strhead) valhead))) (if (or (null? strtail) (null? valtail)) (cons slot-val-pair res);;(print strhead valhead));;(cons (cons (string->symbol strhead) valhead) res)) (loop (car strtail)(cdr strtail)(car valtail)(cdr valtail)(cons slot-val-pair res))))))) (define (db:test-rec-from-qry-long listvals) (make-db:test-rec id: (list-ref listvals 0) run_id: (list-ref listvals 1) testname: (list-ref listvals 2) state: (list-ref listvals 3) status: (list-ref listvals 4) event_time: (list-ref listvals 5) host: (list-ref listvals 6) cpuload: (list-ref listvals 7) diskfree: (list-ref listvals 8) uname: (list-ref listvals 9) rundir: (list-ref listvals 10) item_path: (list-ref listvals 11) run_duration: (list-ref listvals 12) final_logf: (list-ref listvals 13) comment: (list-ref listvals 14) shortdir: (list-ref listvals 15) attemptnum: (list-ref listvals 16) archived: (list-ref listvals 17))) |
︙ |
Modified megatest.scm from [c9c26e5538] to [75fce3918c].
︙ | |||
1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 | 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 | + + + - + | (let ((dat (string-split table-spec ":"))) ;; ("runs" "id,target,runname") (if (> (length dat) 1) (cons (car dat)(string-split (cadr dat) ",")) ;; "id,target,runname" dat))) (string-split fields-spec "+"))) (define (get-value-by-fieldname datavec test-field-index fieldname) (if (db:test-rec? datavec) (let ((test-rec-alist (db:test-rec->alist datavec))) (alist-ref (string->symbol fieldname) test-rec-alist)) (let ((indx (hash-table-ref/default test-field-index fieldname #f))) (if indx (if (>= indx (vector-length datavec)) #f ;; index to high, should raise an error I suppose (vector-ref datavec indx)) |
︙ | |||
1159 1160 1161 1162 1163 1164 1165 | 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 | + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + | (handle-exceptions exn (begin (debug:print-error 0 *default-log-port* "Bad data in test record? " test) (print "exn=" (condition->list exn)) (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (print-call-chain (current-error-port))) (let* ( (test-id (db:test-rec-id test)) (testname (db:test-rec-testname test)) (itempath (db:test-rec-item_path test)) (comment (db:test-rec-comment test)) (tstate (db:test-rec-state test)) (tstatus (db:test-rec-status test)) (event-time (db:test-rec-event_time test)) (rundir (db:test-rec-rundir test)) (final_logf (db:test-rec-final_logf test)) (run_duration (db:test-rec-run_duration test)) (fullname (db:test-rec-testname test)) |
︙ |
Modified run_records.scm from [1580836de1] to [dc88d5585a].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | + + - - - - - - + + + + + + | ;;====================================================================== ;; Copyright 2006-2012, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (include "db_records.scm") (define-inline (runs:runrec-make-record) (make-vector 13)) (define-inline (runs:runrec-get-target vec)(vector-ref vec 0)) ;; a/b/c (define-inline (runs:runrec-get-runname vec)(vector-ref vec 1)) ;; string (define-inline (runs:runrec-testpatt vec)(vector-ref vec 2)) ;; a,b/c,d% (define-inline (runs:runrec-keys vec)(vector-ref vec 3)) ;; (key1 key2 ...) (define-inline (runs:runrec-keyvals vec)(vector-ref vec 4)) ;; ((key1 val1)(key2 val2) ...) (define-inline (runs:runrec-environment vec)(vector-ref vec 5)) ;; environment, alist key val (define-inline (runs:runrec-mconfig vec)(vector-ref vec 6)) ;; megatest.config (define-inline (runs:runrec-runconfig vec)(vector-ref vec 7)) ;; runconfigs.config (define-inline (runs:runrec-serverdat vec)(vector-ref vec 8)) ;; (host port) (define-inline (runs:runrec-transport vec)(vector-ref vec 9)) ;; 'http (define-inline (runs:runrec-db vec)(vector-ref vec 10)) ;; <sqlite3db> (if 'fs) (define-inline (runs:runrec-top-path vec)(vector-ref vec 11)) ;; *toppath* (define-inline (runs:runrec-run_id vec)(vector-ref vec 12)) ;; run-id |
Modified runs.scm from [de4f2b1394] to [ac6ff009be].
︙ | |||
1698 1699 1700 1701 1702 1703 1704 | 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 | - + | (thread-start! worker-thread)) (else (debug:print-info 0 *default-log-port* "action not recognised " action))) ;; actions that operate on one test at a time can be handled below ;; (let ((sorted-tests (filter |
︙ |
Modified tests/fullrun/megatest.config from [73b1295a6b] to [a2007aff6f].
︙ | |||
146 147 148 149 150 151 152 | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | - + | # XTERM [system xterm] # RUNDEAD [system exit 56] [server] # force use of server always |
︙ |