Overview
| Comment: | Added unit tests to cover itemmap |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
81b00e46ccc6e35a4999cd757b75e78d |
| User & Date: | matt on 2015-08-30 19:08:31 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-08-30
| ||
| 23:28 | Fixed order in db:compare-itempaths call in calc-prereqs, added some simple tests for get-prereqs check-in: d1b20f31c1 user: matt tags: v1.60 | |
| 19:08 | Added unit tests to cover itemmap check-in: 81b00e46cc user: matt tags: v1.60 | |
|
2015-08-28
| ||
| 17:20 | Fixed couple bugs check-in: 0feca1db84 user: mrwellan tags: v1.60 | |
Changes
Modified db.scm from [5b045adee9] to [c12aea457f].
| ︙ | ︙ | |||
3264 3265 3266 3267 3268 3269 3270 | ;; M I S C M A N A G E M E N T I T E M S ;;====================================================================== ;; A routine to map itempaths using a itemmap (define (db:compare-itempaths patha pathb itemmap) (debug:print-info 6 "ITEMMAP is " itemmap) (if itemmap | | | | > > > | 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 |
;; M I S C M A N A G E M E N T I T E M S
;;======================================================================
;; A routine to map itempaths using a itemmap
(define (db:compare-itempaths patha pathb itemmap)
(debug:print-info 6 "ITEMMAP is " itemmap)
(if itemmap
(let ((pathb-mapped (db:multi-pattern-apply pathb itemmap)))
(debug:print-info 6 "ITEMMAP is " itemmap ", path: " pathb ", mapped path: " pathb-mapped)
(equal? patha pathb-mapped))
(equal? patha pathb)))
;; (let* ((mapparts (string-split itemmap))
;; (pattern (car mapparts))
;; (replacement (if (> (length mapparts) 1) (cadr mapparts) "")))
;; (if replacement
;; (equal? (string-substitute pattern replacement patha)
;; (string-substitute pattern replacement pathb))
;; (equal? (string-substitute pattern "" patha)
;; (string-substitute pattern "" pathb))))
;; A routine to convert test/itempath using a itemmap
;; NOTE: to process only an itempath (i.e. no prepended testname)
;; just call db:multi-pattern-apply
;;
(define (db:convert-test-itempath path-in itemmap)
(debug:print-info 6 "ITEMMAP is " itemmap)
(let* ((path-parts (string-split path-in "/"))
(test-name (if (null? path-parts) "" (car path-parts)))
(item-path (string-intersperse (if (null? path-parts) '() (cdr path-parts)) "/")))
(conc test-name "/"
(db:multi-pattern-apply item-path itemmap))))
|
| ︙ | ︙ |
Modified tests/unittests/runs.scm from [6312499606] to [a3583581bf].
| ︙ | ︙ | |||
97 98 99 100 101 102 103 | (test "update-test_meta" "test1" (begin (runs:update-test_meta "test1" tconfig) (let ((dat (rmt:testmeta-get-record "test1"))) (vector-ref dat 1)))) (define test-path "tests/test1") (define disk-path #f) | | | 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | (test "update-test_meta" "test1" (begin (runs:update-test_meta "test1" tconfig) (let ((dat (rmt:testmeta-get-record "test1"))) (vector-ref dat 1)))) (define test-path "tests/test1") (define disk-path #f) (test "get-best-disk" #t (string? (file-exists? (let ((d (get-best-disk *configdat* #f))) (set! disk-path d) d)))) (test "create-work-area" #t (symbolic-link? (car (create-work-area 1 rinfo keyvals 1 test-path disk-path "test1" '())))) (test #f "" (item-list->path '())) ;;====================================================================== ;; Create a test with multiple items and verify that rollup logic works |
| ︙ | ︙ | |||
155 156 157 158 159 160 161 | ;; (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat params) (launch-test 30001 1 rinfo keyvals "run1" tconfig "test1" test-path '() (make-hash-table))))) ;;====================================================================== ;; M O R E R E M O T E C A L L S ;;====================================================================== | > > | > | > > > > > > > > | 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 |
;; (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat params)
(launch-test 30001 1 rinfo keyvals "run1" tconfig "test1" test-path '() (make-hash-table)))))
;;======================================================================
;; M O R E R E M O T E C A L L S
;;======================================================================
(test #f '("COMPLETED" "PASS")
(begin
(rmt:set-tests-state-status 1 '("rollup") "COMPLETED" "AUTO" "COMPLETED" "PASS")
(get-state-status 1 "rollup" "")))
(test #f #t (rmt:top-test-set-per-pf-counts 1 "rollup"))
;;======================================================================
;; T E S T I T E M M A P
;;======================================================================
(test #f "a/b/c" (db:multi-pattern-apply "d/e/f" "d a\ne b\nf c"))
(test #f "blah/foo/bar/baz" (db:convert-test-itempath "blah/baz/bar/foo" "^([^/]+)/([^/]+)/([^/]+)$ \\3/\\2/\\1"))
(test #f #t (db:compare-itempaths "abc/def/123" "abc/ghi/123" "ghi def"))
(exit 1)
;; (test "Run a test" #t (general-run-call
|
| ︙ | ︙ |