Overview
| Comment: | Added filtering by field for dumpmode |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
a3ca55343ef0cf5bc2608aa624569406 |
| User & Date: | matt on 2015-06-04 01:09:56 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-06-04
| ||
| 01:30 | Fixed couple issues with -list-runs created by additon of fields filters check-in: 5eaf98203f user: matt tags: v1.60 | |
| 01:09 | Added filtering by field for dumpmode check-in: a3ca55343e user: matt tags: v1.60 | |
|
2015-06-03
| ||
| 21:57 | Changed scary error to the warning it should be, added ability to dump cmdinfo from a value passed in command line, added safety check on access to a testconfig dat in case it wasn't actually read successfully check-in: 50be72f3df user: mrwellan tags: v1.60 | |
Changes
Modified megatest.scm from [854261c21d] to [1a94be3f21].
| ︙ | ︙ | |||
126 127 128 129 130 131 132 133 134 135 136 137 138 139 | -show-config : dump the internal representation of the megatest.config file -show-runconfig : dump the internal representation of the runconfigs.config file -dumpmode json : dump in json format instead of sexpr -show-cmdinfo : dump the command info for a test (run in test environment) -section sectionName -var varName : for config and runconfig lookup value for sectionName varName -since N : get list of runs changed since time N (Unix seconds) Misc -start-dir path : switch to this directory before running megatest -rebuild-db : bring the database schema up to date -cleanup-db : remove any orphan records, vacuum the db -import-megatest.db : migrate a database from v1.55 series to v1.60 series -sync-to-megatest.db : migrate data back to megatest.db | > | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | -show-config : dump the internal representation of the megatest.config file -show-runconfig : dump the internal representation of the runconfigs.config file -dumpmode json : dump in json format instead of sexpr -show-cmdinfo : dump the command info for a test (run in test environment) -section sectionName -var varName : for config and runconfig lookup value for sectionName varName -since N : get list of runs changed since time N (Unix seconds) -fields fieldspec : fields to include in json dump; runs:id,runame+tests:testname+steps Misc -start-dir path : switch to this directory before running megatest -rebuild-db : bring the database schema up to date -cleanup-db : remove any orphan records, vacuum the db -import-megatest.db : migrate a database from v1.55 series to v1.60 series -sync-to-megatest.db : migrate data back to megatest.db |
| ︙ | ︙ | |||
243 244 245 246 247 248 249 250 251 252 253 254 255 256 | "-run-id" "-ping" "-refdb2dat" "-o" "-log" "-archive" "-since" ) (list "-h" "-help" "--help" "-version" "-force" "-xterm" "-showkeys" "-show-keys" | > | 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 | "-run-id" "-ping" "-refdb2dat" "-o" "-log" "-archive" "-since" "-fields" ) (list "-h" "-help" "--help" "-version" "-force" "-xterm" "-showkeys" "-show-keys" |
| ︙ | ︙ | |||
879 880 881 882 883 884 885 886 887 888 889 890 891 |
(rmt:set-run-status run-id (args:get-arg "-set-run-status") msg: (args:get-arg "-m"))
(print (rmt:get-run-status run-id))
)))))))
;;======================================================================
;; Query runs
;;======================================================================
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (launch:setup-for-run)
| > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > > > > > > > | > > > > > > > > > > > > > > > | > > > > > > > > > > | | | | | | | < | | | | | | | | | | | | | | > > > > > | | | | | | | | | | | | < > | 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 |
(rmt:set-run-status run-id (args:get-arg "-set-run-status") msg: (args:get-arg "-m"))
(print (rmt:get-run-status run-id))
)))))))
;;======================================================================
;; Query runs
;;======================================================================
;; -fields runs:id,target,runname,comment+tests:id,testname,item_path+steps
;;
;; csi> (extract-fields-constraints "runs:id,target,runname,comment+tests:id,testname,item_path+steps")
;; => (("runs" "id" "target" "runname" "comment") ("tests" "id" "testname" "item_path") ("steps"))
;;
;; NOTE: remember that the cdr will be the list you expect (cdr ("runs" "id" "target" "runname" "comment")) => ("id" "target" "runname" "comment")
;; and so alist-ref will yield what you expect
;;
(define (extract-fields-constraints fields-spec)
(map (lambda (table-spec) ;; runs:id,target,runname
(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))
#f)))
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (launch:setup-for-run)
(let* ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t))
(runpatt (args:get-arg "-list-runs"))
(testpatt (if (args:get-arg "-testpatt")
(args:get-arg "-testpatt")
"%"))
(keys (db:get-keys dbstruct))
;; (runsda t (db:get-runs dbstruct runpatt #f #f '()))
(runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
#f #f))
(runstmp (db:get-rows runsdat))
(header (db:get-header runsdat))
(runs (if (and (not (null? runstmp))
(args:get-arg "-since"))
(let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))
(let loop ((hed (car runstmp))
(tal (cdr runstmp))
(res '()))
(let ((new-res (if (member (db:get-value-by-header hed header "id") changed-ids)
(cons hed res)
res)))
(if (null? tal)
(reverse new-res)
(loop (car tal)(cdr tal) new-res)))))
runstmp))
(db-targets (args:get-arg "-list-db-targets"))
(seen (make-hash-table))
(dmode (let ((d (args:get-arg "-dumpmode")))
(if d (string->symbol d) #f)))
(data (make-hash-table))
(fields-spec (if (args:get-arg "-fields")
(extract-fields-constraints (args:get-arg "-fields"))
'(("runs" "id" "target" "runname")
("tests" "id" "testname" "test_path")
("steps" "id" "stepname"))))
(runs-spec (alist-ref "runs" fields-spec equal?))
(tests-spec (alist-ref "tests" fields-spec equal?))
(adj-tests-spec (delete-duplicates (cons "id" tests-spec)))
(steps-spec (alist-ref "steps" fields-spec equal?))
(test-field-index (make-hash-table)))
(if (and tests-spec (not (null? tests-spec))) ;; do some validation and processing of the test-spec
(let ((invalid-tests-spec (filter (lambda (x)(not (member x db:test-record-fields))) tests-spec)))
(if (null? invalid-tests-spec)
;; generate the lookup map test-field-name => index-number
(let loop ((hed (car adj-tests-spec))
(tal (cdr adj-tests-spec))
(idx 0))
(hash-table-set! test-field-index hed idx)
(if (not (null? tal))(loop (car tal)(cdr tal)(+ idx 1))))
(begin
(debug:print 0 "ERROR: Invalid test fields specified: " (string-intersperse invalid-tests-spec ", "))
(exit)))))
(debug:print-info 0 "runs-spec: " runs-spec ", tests-spec: " tests-spec ", steps-spec: " steps-spec)
;; Each run
(for-each
(lambda (run)
(let ((targetstr (string-intersperse (map (lambda (x)
(db:get-value-by-header run header x))
keys) "/")))
(if db-targets
(if (not (hash-table-ref/default seen targetstr #f))
(begin
(hash-table-set! seen targetstr #t)
;; (print "[" targetstr "]"))))
(if (not dmode)(print targetstr))))
(let* ((run-id (db:get-value-by-header run header "id"))
(runname (db:get-value-by-header run header "runname"))
(tests (if tests-spec
(db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc
;; use qryvals if test-spec provided
(if tests-spec
(string-intersperse adj-tests-spec ",")
#f))
'())))
(case dmode
((json)
(if runs-spec
(for-each
(lambda (field-name)
(mutils:hierhash-set! data (conc (db:get-value-by-header run header field-name)) targetstr runname "meta" field-name))
runs-spec)))
;; (mutils:hierhash-set! data (db:get-value-by-header run header "status") targetstr runname "meta" "status" )
;; (mutils:hierhash-set! data (db:get-value-by-header run header "state") targetstr runname "meta" "state" )
;; (mutils:hierhash-set! data (conc (db:get-value-by-header run header "id")) targetstr runname "meta" "id" )
;; (mutils:hierhash-set! data (db:get-value-by-header run header "event_time") targetstr runname "meta" "event_time" )
;; (mutils:hierhash-set! data (db:get-value-by-header run header "comment") targetstr runname "meta" "comment" )
;; ;; add last entry twice - seems to be a bug in hierhash?
;; (mutils:hierhash-set! data (db:get-value-by-header run header "comment") targetstr runname "meta" "comment" )
(else
(print "Run: " targetstr "/" runname
" status: " (db:get-value-by-header run header "state")
" run-id: " run-id ", number tests: " (length tests))))
(for-each
(lambda (test)
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: Bad data in test record? " test)
(print "exn=" (condition->list exn))
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain (current-error-port)))
(let* ((test-id (get-value-by-fieldname test test-field-index "id" )) ;; (db:test-get-id test))
(testname (get-value-by-fieldname test test-field-index "testname" )) ;; (db:test-get-testname test))
(itempath (get-value-by-fieldname test test-field-index "item_path")) ;; (db:test-get-item-path test))
(comment (get-value-by-fieldname test test-field-index "comment" )) ;; (db:test-get-comment test))
(tstate (get-value-by-fieldname test test-field-index "state" )) ;; (db:test-get-state test))
(tstatus (get-value-by-fieldname test test-field-index "status" )) ;; (db:test-get-status test))
(event-time (get-value-by-fieldname test test-field-index "event_time")) ;; (db:test-get-event_time test))
(rundir (get-value-by-fieldname test test-field-index "rundir" )) ;; (db:test-get-rundir test))
(final_logf (get-value-by-fieldname test test-field-index "final_logf")) ;; (db:test-get-final_logf test))
(run_duration (get-value-by-fieldname test test-field-index "run_duration")) ;; (db:test-get-run_duration test))
(fullname (conc testname
(if (equal? itempath "")
""
(conc "(" itempath ")")))))
(case dmode
((json)
(if tests-spec
(for-each
(lambda (field-name)
(mutils:hierhash-set! data (get-value-by-fieldname test test-field-index field-name) targetstr runname "data" (conc test-id) field-name))
tests-spec)))
;; ;; (mutils:hierhash-set! data fullname targetstr runname "data" (conc test-id) "tname" )
;; (mutils:hierhash-set! data testname targetstr runname "data" (conc test-id) "testname" )
;; (mutils:hierhash-set! data itempath targetstr runname "data" (conc test-id) "itempath" )
;; (mutils:hierhash-set! data comment targetstr runname "data" (conc test-id) "comment" )
;; (mutils:hierhash-set! data tstate targetstr runname "data" (conc test-id) "state" )
;; (mutils:hierhash-set! data tstatus targetstr runname "data" (conc test-id) "status" )
;; (mutils:hierhash-set! data rundir targetstr runname "data" (conc test-id) "rundir" )
;; (mutils:hierhash-set! data final_logf targetstr runname "data" (conc test-id) "final_logf")
;; (mutils:hierhash-set! data run_duration targetstr runname "data" (conc test-id) "run_duration")
;; (mutils:hierhash-set! data event-time targetstr runname "data" (conc test-id) "event_time")
;; ;; add last entry twice - seems to be a bug in hierhash?
;; (mutils:hierhash-set! data event-time targetstr runname "data" (conc test-id) "event_time")
;; )
(else
(format #t
" Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
fullname
tstate
tstatus
(db:test-get-run_duration test)
|
| ︙ | ︙ |