Megatest

Check-in [81b00e46cc]
Login
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: 81b00e46ccc6e35a4999cd757b75e78de09bc15b
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
3271
3272
3273



3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285



3286
3287
3288
3289
3290
3291
3292
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 ((path-b-mapped (db:convert-test-itempath pathb itemmap)))
	(debug:print-info 6 "ITEMMAP is " itemmap ", path: " pathb ", mapped path: " path-b-mapped)
	(equal? patha pathb))
      (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
104

105
106
107
108
109
110
111
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*)))
(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


162
163











164
165
166
167
168
169
170
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
(test #f #f (rmt:set-tests-state-status 1 '("runfirst") "RUNNING" "WARN" "COMPLETED" "FAIL"))
(test #f #f (rmt:top-test-set-per-pf-counts 1 "runfirst"))
	(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