Megatest

Check-in [777bae8a54]
Login
Overview
Comment:Added function to get tests that match a tag list/pattern: tag1,tag2,tpatt% etc. (runs::get-tests-matching-tags tagpatts)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63
Files: files | file ages | folders
SHA1: 777bae8a540a6211e99d7afdef1982301e299648
User & Date: mrwellan on 2016-12-19 22:32:54
Other Links: branch diff | manifest | tags
Context
2016-12-21
09:01
Refactored exit process to hopefully reduce rate of stuck processes check-in: e8d5f184c1 user: mrwellan tags: v1.63
2016-12-20
16:23
added -mode and -tagexpr options Closed-Leaf check-in: 38b7f592d7 user: bjbarcla tags: v1.63-tag-mode
2016-12-19
22:50
Automated merge of v1.63/777bae8a54/integ into integ-home check-in: 94d4e0a530 user: matt tags: integ-home
22:32
Added function to get tests that match a tag list/pattern: tag1,tag2,tpatt% etc. (runs::get-tests-matching-tags tagpatts) check-in: 777bae8a54 user: mrwellan tags: v1.63
16:51
fixed bugs in dashboard where runs are duplicated in runs tab and statistics of summary tab check-in: 146fa45671 user: bjbarcla tags: v1.63
Changes

Modified api.scm from [9a1ea8a047] to [19e6c44e9d].

37
38
39
40
41
42
43

44
45
46
47
48
49
50
    get-count-tests-running-for-run-id
    get-run-info
    get-run-status
    get-run-stats
    get-targets
    get-target
    ;; register-run

    get-tests-for-run
    get-test-id
    get-tests-for-runs-mindata
    get-run-name-from-id
    get-runs
    get-num-runs
    get-all-run-ids







>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
    get-count-tests-running-for-run-id
    get-run-info
    get-run-status
    get-run-stats
    get-targets
    get-target
    ;; register-run
    get-tests-tags
    get-tests-for-run
    get-test-id
    get-tests-for-runs-mindata
    get-run-name-from-id
    get-runs
    get-num-runs
    get-all-run-ids
166
167
168
169
170
171
172

173
174
175
176
177
178
179
	    ((sync-inmem->db)               (let ((run-id (car params)))
					      (db:sync-touched dbstruct run-id force-sync: #t)))
	    ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))

	    ;; TESTMETA
	    ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
	    ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))


	    ;; TASKS
	    ((tasks-add)                 (apply tasks:add dbstruct params))   
	    ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
	    ((tasks-get-last)            (apply tasks:get-last dbstruct params))

	    ;; ARCHIVES







>







167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
	    ((sync-inmem->db)               (let ((run-id (car params)))
					      (db:sync-touched dbstruct run-id force-sync: #t)))
	    ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))

	    ;; TESTMETA
	    ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
	    ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
            ((get-tests-tags)            (db:get-tests-tags dbstruct))

	    ;; TASKS
	    ((tasks-add)                 (apply tasks:add dbstruct params))   
	    ((tasks-set-state-given-param-key) (apply tasks:set-state-given-param-key dbstruct params))
	    ((tasks-get-last)            (apply tasks:get-last dbstruct params))

	    ;; ARCHIVES

Modified db.scm from [d719c9f795] to [ff97966612].

2594
2595
2596
2597
2598
2599
2600



2601
2602
2603
2604
2605
2606
2607
		      (string-intersperse testnames "','")
		      "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ???
	       ))
	    0)))))
             ;; DEBUG FIXME - need to merge this v.155 query correctly   
             ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
             ;; AND NOT (uname = 'n/a' AND item_path = '');"




;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining dbstruct run-id)
  (db:with-db
   dbstruct
   run-id







>
>
>







2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
		      (string-intersperse testnames "','")
		      "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ???
	       ))
	    0)))))
             ;; DEBUG FIXME - need to merge this v.155 query correctly   
             ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
             ;; AND NOT (uname = 'n/a' AND item_path = '');"

;; tags: '("tag%" "tag2" "%ag6")
;;

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining dbstruct run-id)
  (db:with-db
   dbstruct
   run-id
3633
3634
3635
3636
3637
3638
3639



















3640
3641
3642
3643
3644
3645
3646
	"SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '';"
	test-name)
       res))))

;;======================================================================
;; Tests meta data
;;======================================================================




















;; read the record given a testname
(define (db:testmeta-get-record dbstruct testname)
  (let ((res   #f))
    (db:with-db
     dbstruct
     #f







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
	"SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '';"
	test-name)
       res))))

;;======================================================================
;; Tests meta data
;;======================================================================

;; returns a hash table of tags to tests
;;
(define (db:get-tests-tags dbstruct)
  (let* ((dbdat   (db:get-db dbstruct #f))
	 (db      (db:dbdat-get-db dbdat))
         (res     (make-hash-table)))
    (sqlite3:for-each-row
     (lambda (testname tags-in)
       (let ((tags (string-split tags-in ",")))
         (for-each
          (lambda (tag)
            (hash-table-set! res tag
                             (delete-duplicates
                              (cons testname (hash-table-ref/default res tag '())))))
          tags)))
     db
     "SELECT testname,tags FROM test_meta")
    res))

;; read the record given a testname
(define (db:testmeta-get-record dbstruct testname)
  (let ((res   #f))
    (db:with-db
     dbstruct
     #f

Modified megatest.scm from [da4e664704] to [e236b0be17].

1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865

(if (args:get-arg "-update-meta")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 *default-log-port* "Failed to setup, exiting") 
	    (exit 1)))
      ;; now can find our db
      ;; keep this one local
      (open-run-close runs:update-all-test_meta #f)
      (set! *didsomething* #t)))

;;======================================================================
;; Start a repl
;;======================================================================

;; fakeout readline







<
<
|







1849
1850
1851
1852
1853
1854
1855


1856
1857
1858
1859
1860
1861
1862
1863

(if (args:get-arg "-update-meta")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 *default-log-port* "Failed to setup, exiting") 
	    (exit 1)))


      (runs:update-all-test_meta #f)
      (set! *didsomething* #t)))

;;======================================================================
;; Start a repl
;;======================================================================

;; fakeout readline

Modified rmt.scm from [209649af60] to [f13d98b31b].

333
334
335
336
337
338
339







340
341
342
343
344
345
346
(define (rmt:sdb-qry qry val run-id)
  ;; add caching if qry is 'getid or 'getstr
  (rmt:send-receive 'sdb-qry run-id (list qry val)))

;; NOT COMPLETED
(define (rmt:runtests user run-id testpatt params)
  (rmt:send-receive 'runtests run-id testpatt))








;;======================================================================
;;  K E Y S 
;;======================================================================

;; These require run-id because the values come from the run!
;;







>
>
>
>
>
>
>







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
(define (rmt:sdb-qry qry val run-id)
  ;; add caching if qry is 'getid or 'getstr
  (rmt:send-receive 'sdb-qry run-id (list qry val)))

;; NOT COMPLETED
(define (rmt:runtests user run-id testpatt params)
  (rmt:send-receive 'runtests run-id testpatt))

;;======================================================================
;;  T E S T   M E T A 
;;======================================================================

(define (rmt:get-tests-tags)
  (rmt:send-receive 'get-tests-tags #f '()))

;;======================================================================
;;  K E Y S 
;;======================================================================

;; These require run-id because the values come from the run!
;;

Modified runs.scm from [ebf1e29df4] to [b5157dd5f4].

1956
1957
1958
1959
1960
1961
1962













1963
1964
1965
1966
1967
1968
1969
	      (val (config-lookup test-conf "test_meta" fld)))
	 ;; (debug:print 5 *default-log-port* "idx: " idx " fld: " fld " val: " val)
	 (if (and val (not (equal? (vector-ref currrecord idx) val)))
	     (begin
	       (print "Updating " test-name " " fld " to " val)
	       (rmt:testmeta-update-field test-name fld val)))))
     '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)("jobgroup" 10)))))














;; Update test_meta for all tests
(define (runs:update-all-test_meta db)
  (let ((test-names (tests:get-all))) ;; (tests:get-valid-tests)))
    (for-each 
     (lambda (test-name)
       (let* ((test-conf    (mt:lazy-read-test-config test-name)))







>
>
>
>
>
>
>
>
>
>
>
>
>







1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
	      (val (config-lookup test-conf "test_meta" fld)))
	 ;; (debug:print 5 *default-log-port* "idx: " idx " fld: " fld " val: " val)
	 (if (and val (not (equal? (vector-ref currrecord idx) val)))
	     (begin
	       (print "Updating " test-name " " fld " to " val)
	       (rmt:testmeta-update-field test-name fld val)))))
     '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)("jobgroup" 10)))))

;; find tests with matching tags, tagpatt is a string "tagpatt1,tagpatt2%, ..."
;;
(define (runs:get-tests-matching-tags tagpatt)
  (let* ((tagdata (rmt:get-tests-tags))
         (res     '())) ;; list of tests that match one or more tags
    (for-each
     (lambda (tag)
       (if (patt-list-match tag tagpatt)
           (set! res (append (hash-table-ref tagdata tag)))))
     (hash-table-keys tagdata))
    res))
    

;; Update test_meta for all tests
(define (runs:update-all-test_meta db)
  (let ((test-names (tests:get-all))) ;; (tests:get-valid-tests)))
    (for-each 
     (lambda (test-name)
       (let* ((test-conf    (mt:lazy-read-test-config test-name)))