Changes In Branch defstruct-srehman Through [be5c8e1cdb] Excluding Merge-Ins
This is equivalent to a diff from e24aa68ed5 to be5c8e1cdb
2016-09-27
| ||
12:00 | fixed setters for typed-record 'db:test-rec' check-in: 85157b687d user: srehman tags: defstruct-srehman | |
2016-09-26
| ||
18:18 | reverted comments and print statements on runs.scm check-in: be5c8e1cdb user: srehman tags: defstruct-srehman | |
18:15 | refactored to use typed-record instead of vector in megatest.scm check-in: 3e5400a237 user: srehman tags: defstruct-srehman | |
13:40 | Convert from vector record to defstruct for dbr:dbstruct check-in: 7c0396e31d user: mrwellan tags: v1.62 | |
2016-09-23
| ||
15:18 | Update db check-in: b6c50d722b user: ritikaag tags: db | |
11:16 | merged with latest v1.62 check-in: d9c3068419 user: srehman tags: defstruct-srehman | |
2016-09-21
| ||
09:11 | moved readline fix include out of the if. Update copyright date. Block when running db migration IF version bumped check-in: e24aa68ed5 user: mrwellan tags: v1.62 | |
2016-09-19
| ||
11:08 | Put the db migration into a thread to not block starting the dashboard check-in: 3046301f07 user: mrwellan tags: v1.62 | |
Modified dashboard.scm from [40b640dfe5] to [f6381828f9].
︙ | ︙ | |||
900 901 902 903 904 905 906 | (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) | | > | 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 | (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 "" "") (make-db:test-rec id: -1) ;; (car matching)))) matching))) (testname (db:test-get-testname testdat)) (itempath (db:test-get-item-path testdat)) (testfullname (test:test-get-fullname testdat)) (teststatus (db:test-get-status testdat)) (teststate (db:test-get-state testdat)) |
︙ | ︙ | |||
1419 1420 1421 1422 1423 1424 1425 | (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) | | | | 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 | (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) (let* ((aval (db:test-get-testname a));;(vector-ref a 2)) (bval (db:test-get-testname b));;(vector-ref b 2)) (anum (string->number aval)) (bnum (string->number bval))) (if (and anum bnum) (< anum bnum) (string<= aval bval))))))) |
︙ | ︙ |
Modified db.scm from [248b7f3532] to [2692e38780].
︙ | ︙ | |||
2256 2257 2258 2259 2260 2261 2262 | ";" ))) (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) | | > > > | 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 | ";" ))) (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) ;;(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) ;;(print (cons a b)) (set! res (cons (alist->db:test-rec (db:qry-gen-alist qryvalstr (cons a b))) res))) db qry run-id ))) (case qryvals ((shortlist)(map db:test-short-record->norm res)) ((#f) res) |
︙ | ︙ | |||
2289 2290 2291 2292 2293 2294 2295 | (if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))) (debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (id testname item-path state status) ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment | | > | | > | 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 | (if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))) (debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (id testname item-path state status) ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment ;;(set! res (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res))) (set! res (cons (make-db:test-rec id: id testname: testname item_path: item-path state: state status: status) res))) db qry run-id))) res)) (define (db:get-testinfo-state-status dbstruct run-id test-id) (let ((res '())) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (run-id testname item-path state status) ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment ;;(set! res (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-"))) (set! res (make-db:test-rec run_id: run-id testname: testname item_path: item-path state: state status: status))) db "SELECT run_id,testname,item_path,state,status FROM tests WHERE id=?;" test-id))) res)) ;; get a useful subset of the tests data (used in dashboard ;; use db:mintest-get-{id ,run_id,testname ...} |
︙ | ︙ | |||
2571 2572 2573 2574 2575 2576 2577 | (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 | | | > > > > | 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 | (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 (lambda (id run_id testname state status event_time host cpuload diskfree uname rundir item_path run_duration final_logf comment shortdir attemptnum archived) ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 ;;(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum archived) (set! res (cons (make-db:test-rec id: id run_id: run_id testname: testname state: state status: status event_time: event_time host: host cpuload: cpuload diskfree: diskfree uname: uname rundir: rundir item_path: item_path run_duration: run_duration final_logf: final_logf comment: comment shortdir: shortdir attemptnum: attemptnum archived: archived ) res))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;") run-id) res)) (define (db:replace-test-records dbstruct run-id testrecs) |
︙ | ︙ | |||
2648 2649 2650 2651 2652 2653 2654 | (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 | | | > > > > > | > | | 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 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 | (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 (lambda (id run_id testname state status event_time host cpuload diskfree uname rundir item_path run_duration final_logf comment shortdir attemptnum archived) ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 ;;(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final-logf comment short-dir attemptnum archived))) (set! res (make-db:test-rec id: id run_id: run_id testname: testname state: state status: status event_time: event_time host: host cpuload: cpuload diskfree: diskfree uname: uname rundir: rundir item_path: item_path run_duration: run_duration final_logf: final_logf comment: comment shortdir: shortdir attemptnum: attemptnum archived: archived ))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;") test-id) res)))) ;; Use db:test-get* to access ;; Get test data using test_ids. NB// Only works within a single run!! ;; (define (db:get-test-info-by-ids dbstruct run-id test-ids) (db:with-db dbstruct run-id #f (lambda (db) (let ((res '())) (sqlite3:for-each-row (lambda (a . b) ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 (set! res (cons (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b))) res))) ;;(set! res (cons (apply vector a b) res))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in (" (string-intersperse (map conc test-ids) ",") ");")) res)))) (define (db:get-test-info dbstruct run-id testname item-path) (db:with-db dbstruct run-id #f (lambda (db) (let ((res #f)) (sqlite3:for-each-row (lambda (a . b) (set! res (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b))))) ;;(set! res (apply vector a b))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=?;") test-name item-path) res)))) (define (db:test-get-rundir-from-test-id dbstruct run-id test-id) (db:with-db |
︙ | ︙ |
Modified db_records.scm from [64b6bb0323] to [5b2f22e401].
︙ | ︙ | |||
63 64 65 66 67 68 69 70 | ;; (define (dbr:dbstruct-get-localdb v run-id) (hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f)) (define (dbr:dbstruct-set-localdb! v run-id db) (hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db)) | > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > | > | | | | | | | | | < | | | | | | | | 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 | ;; (define (dbr:dbstruct-get-localdb v run-id) (hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f)) (define (dbr:dbstruct-set-localdb! v run-id db) (hash-table-set! (dbr:dbstruct-get-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)) "id" "run_id" "testname" "state" "status" "event_time" "host" "cpuload" "diskfree" "uname" "rundir" "item_path" "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived" (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-get-id typed-rec) (db:test-rec-id typed-rec)) (define (db:test-get-run_id typed-rec) (db:test-rec-run_id typed-rec)) (define (db:test-get-testname typed-rec) (db:test-rec-testname typed-rec)) (define (db:test-get-state typed-rec) (db:test-rec-state typed-rec)) (define (db:test-get-status typed-rec) (db:test-rec-status typed-rec)) (define (db:test-get-event_time typed-rec) (db:test-rec-event_time typed-rec)) (define (db:test-get-host typed-rec) (db:test-rec-host typed-rec)) (define (db:test-get-cpuload typed-rec) (db:test-rec-cpuload typed-rec)) (define (db:test-get-diskfree typed-rec) (db:test-rec-diskfree typed-rec)) (define (db:test-get-uname typed-rec) (db:test-rec-uname typed-rec)) (define (db:test-get-rundir typed-rec) (db:test-rec-rundir typed-rec)) (define (db:test-get-item-path typed-rec) (db:test-rec-item_path typed-rec)) (define (db:test-get-run_duration typed-rec) (db:test-rec-run_duration typed-rec)) (define (db:test-get-final_logf typed-rec) (db:test-rec-final_logf typed-rec)) (define (db:test-get-comment typed-rec) (db:test-rec-comment typed-rec)) (define (db:test-get-process_id typed-rec) (db:test-rec-process-id typed-rec)) (define (db:test-get-archived typed-rec) (db:test-rec-archived typed-rec)) ;; (define-inline (db:test-get-pass_count vec) (vector-ref vec 15)) ;; (define-inline (db:test-get-fail_count vec) (vector-ref vec 16)) (define-inline (db:test-get-fullname vec) (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec))) ;; replace runs:make-full-test-name with this routine |
︙ | ︙ |
Modified megatest.scm from [c9c26e5538] to [75fce3918c].
︙ | ︙ | |||
1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 | (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) (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)) | > > > | | 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)) #f)))) ;; NOTE: list-runs and list-db-targets operate on local db!!! ;; ;; IDEA: megatest list -runname blah% ... ;; (if (or (args:get-arg "-list-runs") (args:get-arg "-list-db-targets")) |
︙ | ︙ | |||
1159 1160 1161 1162 1163 1164 1165 | (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))) | > > > > > > > > > > > > | | | | | | | | | | | 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)) ;;(test-id (if (member "id" tests-spec)(get-value-by-fieldname test test-field-index "id" ) #f)) ;; (db:test-get-id test)) ;;(testname (if (member "testname" tests-spec)(get-value-by-fieldname test test-field-index "testname" ) #f)) ;; (db:test-get-testname test)) ;;(itempath (if (member "item_path" tests-spec)(get-value-by-fieldname test test-field-index "item_path" ) #f)) ;; (db:test-get-item-path test)) ;;(comment (if (member "comment" tests-spec)(get-value-by-fieldname test test-field-index "comment" ) #f)) ;; (db:test-get-comment test)) ;;(tstate (if (member "state" tests-spec)(get-value-by-fieldname test test-field-index "state" ) #f)) ;; (db:test-get-state test)) ;;(tstatus (if (member "status" tests-spec)(get-value-by-fieldname test test-field-index "status" ) #f)) ;; (db:test-get-status test)) ;;(event-time (if (member "event_time" tests-spec)(get-value-by-fieldname test test-field-index "event_time" ) #f)) ;; (db:test-get-event_time test)) ;;(rundir (if (member "rundir" tests-spec)(get-value-by-fieldname test test-field-index "rundir" ) #f)) ;; (db:test-get-rundir test)) ;;(final_logf (if (member "final_logf" tests-spec)(get-value-by-fieldname test test-field-index "final_logf" ) #f)) ;; (db:test-get-final_logf test)) ;;(run_duration (if (member "run_duration" tests-spec)(get-value-by-fieldname test test-field-index "run_duration") #f)) ;; (db:test-get-run_duration test)) (fullname (conc testname (if (equal? itempath "") "" (conc "(" itempath ")"))))) (case dmode ((json ods) (if tests-spec |
︙ | ︙ |
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 | ;;====================================================================== ;; 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. ;;====================================================================== (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 | > > | | | | | | | 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 (define-inline (test:get-id vec) (db:test-rec-id vec)) (define-inline (test:get-run_id vec) (db:test-rec-run_id vec)) (define-inline (test:get-test-name vec)(db:test-rec-testname vec)) (define-inline (test:get-state vec) (db:test-rec-state vec)) (define-inline (test:get-status vec) (db:test-rec-status vec)) (define-inline (test:get-item-path vec)(db:test-rec-item_path vec)) (define-inline (test:test-get-fullname test) (conc (db:test-get-testname test) (if (equal? (db:test-get-item-path test) "") "" (conc "(" (db:test-get-item-path test) ")")))) |
Modified runs.scm from [de4f2b1394] to [ac6ff009be].
︙ | ︙ | |||
1698 1699 1700 1701 1702 1703 1704 | (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 | | | 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 db:test-rec? (sort tests (lambda (a b)(let ((dira ;; (rmt:sdb-qry 'getstr (db:test-get-rundir a)) ;; ) ;; (filedb:get-path *fdb* (db:test-get-rundir a))) (dirb ;; (rmt:sdb-qry 'getstr (db:test-get-rundir b))) ;; ) ;; ((filedb:get-path *fdb* (db:test-get-rundir b)))) (if (and (string? dira)(string? dirb)) (> (string-length dira)(string-length dirb)) #f)))))) |
︙ | ︙ |