Megatest

Check-in [634c52d06c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:runs.scm - give error instead of setting ZERO_ITEMS. all-api.scm - added some tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 634c52d06c7fd44853ffba7bf5dce34256570a7f
User & Date: mmgraham on 2019-11-06 16:00:33
Other Links: branch diff | manifest | tags
Context
2019-11-07
10:55
updated version check-in: 368d761da8 user: pjhatwal tags: v1.65, v1.6537
2019-11-06
16:00
runs.scm - give error instead of setting ZERO_ITEMS. all-api.scm - added some tests check-in: 634c52d06c user: mmgraham tags: v1.65
2019-10-24
11:16
added notification hook for feedback check-in: b3fbd7024b user: pjhatwal tags: v1.65
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified runs.scm from [098355e5d0] to [715f6645aa].

︙︙
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602

          (let* ((items-in-testpatt
                  (filter
                   (lambda (my-itemdat)
                     (tests:match test-patts hed (item-list->path my-itemdat) ))
                   ;; was: (tests:match test-patts hed (item-list->path my-itemdat) required: required-tests))
                   items) ))
            (if (null? items-in-testpatt)
                (let ((test-id   (rmt:get-test-id run-id test-name "")))
                  (debug:print-info 0 *default-log-port* "Test " (tests:testqueue-get-testname test-record) " is itemized but has no items matching test pattern -- marking status ZERO_ITEMS")
                  (if test-id
                      (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "ZERO_ITEMS" "This test has no items which match test pattern.")))
                
                (for-each (lambda (my-itemdat)
                            (let* ((new-test-record (let ((newrec (make-tests:testqueue)))
                                                      (vector-copy! test-record newrec)
                                                      newrec))
                                   (my-item-path (item-list->path my-itemdat))









<
|
<
<








1585
1586
1587
1588
1589
1590
1591

1592


1593
1594
1595
1596
1597
1598
1599

          (let* ((items-in-testpatt
                  (filter
                   (lambda (my-itemdat)
                     (tests:match test-patts hed (item-list->path my-itemdat) ))
                   ;; was: (tests:match test-patts hed (item-list->path my-itemdat) required: required-tests))
                   items) ))
            (if (null? items-in-testpatt)

                (debug:print-error 0 *default-log-port* "Test " (tests:testqueue-get-testname test-record) " is itemized but has no items matching the test pattern")


                
                (for-each (lambda (my-itemdat)
                            (let* ((new-test-record (let ((newrec (make-tests:testqueue)))
                                                      (vector-copy! test-record newrec)
                                                      newrec))
                                   (my-item-path (item-list->path my-itemdat))
︙︙
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674

          (debug:print-info 4 *default-log-port* "cond branch - "  "rtq-8")
	  (debug:print-info 0 *default-log-port* "Have leftovers!")
	  (loop (car reg)(cdr reg) '() reruns))
	 (else
          (debug:print-info 4 *default-log-port* "cond branch - "  "rtq-9")
	  (debug:print-info 4 *default-log-port* "Exiting loop with...\n  hed=" hed "\n  tal=" tal "\n  reruns=" reruns))
	 ))) ;; end loop on sorted test names
    ;; this is the point where everything is launced and now you can mark the run in metadata table as all launced 
    (rmt:set-var (conc "lunch-complete-" run-id) "yes")
  
    ;; now *if* -run-wait we wait for all tests to be done
    ;; Now wait for any RUNNING tests to complete (if in run-wait mode)
    (thread-sleep! 10) ;; I think there is a race condition here. Let states/statuses settle
    (let wait-loop ((num-running      (rmt:get-count-tests-running-for-run-id run-id))
		    (prev-num-running 0))








|








1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671

          (debug:print-info 4 *default-log-port* "cond branch - "  "rtq-8")
	  (debug:print-info 0 *default-log-port* "Have leftovers!")
	  (loop (car reg)(cdr reg) '() reruns))
	 (else
          (debug:print-info 4 *default-log-port* "cond branch - "  "rtq-9")
	  (debug:print-info 4 *default-log-port* "Exiting loop with...\n  hed=" hed "\n  tal=" tal "\n  reruns=" reruns))
	 ))) ;; end loop on sorted test names
    ;; this is the point where everything is launched and now you can mark the run in metadata table as all launched 
    (rmt:set-var (conc "lunch-complete-" run-id) "yes")
  
    ;; now *if* -run-wait we wait for all tests to be done
    ;; Now wait for any RUNNING tests to complete (if in run-wait mode)
    (thread-sleep! 10) ;; I think there is a race condition here. Let states/statuses settle
    (let wait-loop ((num-running      (rmt:get-count-tests-running-for-run-id run-id))
		    (prev-num-running 0))
︙︙

Modified tests/unittests/all-api.scm from [a91f2ca1b8] to [60bcb491ab].

︙︙
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

(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-data-info-by-id (list 1))) 0))
(test #f  '(#t "successful login") (vector-ref (api:execute-requests my-dbstruct (vector 'login (list toppath megatest-version "Fred"))) 1))
(test #f '(-1 . 0) (vector-ref (api:execute-requests my-dbstruct (vector 'get-latest-host-load (list "localhost"))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-changed-record-ids (list 0))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-run-record-ids (list "%" 1 keys "%/%"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-not-completed-cnt (list 1))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-tags (list ))) 0))
;; no such query supported in api.scm, but it is is the list of read-only queries.
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-times (list ))) 0))
(test #f '("SYSTEM" "RELEASE") (vector-ref (api:execute-requests my-dbstruct (vector 'get-keys-write (list ))) 1))
(test #f  (vector '("SYSTEM" "RELEASE") '())(vector-ref (api:execute-requests my-dbstruct (vector 'get-targets (list 1 ))) 1))
(test #f "" (vector-ref (api:execute-requests my-dbstruct (vector 'get-target (list 1 ))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'general-call (list 'register-test 1 1 "foo" ""))) 0))
(test #f 1 (vector-ref (api:execute-requests my-dbstruct (vector 'get-test-id (list 1 "foo" ""))) 1))
(test #f "/tmp/badname" (vector-ref (api:execute-requests my-dbstruct (vector 'test-get-rundir-from-test-id (list 1 1))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'set-tests-state-status (list 1 '("foo") "COMPLETED" "PASS" "NOT_STARTED" "PASS"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-set-state-status-by-id (list 1 1 "COMPLETED" "PASS" "Just testing!"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-for-run (list 1 "%" '() '() #f #f #f #f #f #f 0 #f))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-for-run-mindata (list 1  "%" '("COMPLETED") '("PASS") #f ))) 0))
;; api.scm calls db:get-tests-for-runs-mindata, which does not exist.
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-for-runs-mindata (list 1  "%" '("COMPLETED") '("PASS") #f ))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'delete-test-records (list 1 2 ))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-set-state-status (list 1 1 "COMPLETED" "FAIL" "Another message" ))) 0))
;; api.scm calls db:get-previous-test-run-record, which does not exist.
;;(test #f '() (vector-ref (api:execute-requests my-dbstruct (vector "get-previous-test-run-record" (list 1 ))) 1))
(test #f '() (vector-ref (api:execute-requests my-dbstruct (vector 'get-matching-previous-test-run-records (list 1 "foo" ""))) 1))
(test #f '("/tmp/badname" "logs/final.log") (vector-ref (api:execute-requests my-dbstruct (vector 'test-get-logfile-info (list 1 "foo"))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-get-records-for-index-file (list 1 "foo"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-testinfo-state-status (list 1 1))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'general-call (list 'test-set-log 1 "/tmp/another/logfile/eh" 1))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-set-archive-block-id (list 1 1 123))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-set-top-process-pid (list 1 1 123))) 0))








<
<










<
<


<
<








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

(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-data-info-by-id (list 1))) 0))
(test #f  '(#t "successful login") (vector-ref (api:execute-requests my-dbstruct (vector 'login (list toppath megatest-version "Fred"))) 1))
(test #f '(-1 . 0) (vector-ref (api:execute-requests my-dbstruct (vector 'get-latest-host-load (list "localhost"))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-changed-record-ids (list 0))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-run-record-ids (list "%" 1 keys "%/%"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-not-completed-cnt (list 1))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-tags (list ))) 0))


(test #f '("SYSTEM" "RELEASE") (vector-ref (api:execute-requests my-dbstruct (vector 'get-keys-write (list ))) 1))
(test #f  (vector '("SYSTEM" "RELEASE") '())(vector-ref (api:execute-requests my-dbstruct (vector 'get-targets (list 1 ))) 1))
(test #f "" (vector-ref (api:execute-requests my-dbstruct (vector 'get-target (list 1 ))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'general-call (list 'register-test 1 1 "foo" ""))) 0))
(test #f 1 (vector-ref (api:execute-requests my-dbstruct (vector 'get-test-id (list 1 "foo" ""))) 1))
(test #f "/tmp/badname" (vector-ref (api:execute-requests my-dbstruct (vector 'test-get-rundir-from-test-id (list 1 1))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'set-tests-state-status (list 1 '("foo") "COMPLETED" "PASS" "NOT_STARTED" "PASS"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-set-state-status-by-id (list 1 1 "COMPLETED" "PASS" "Just testing!"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-for-run (list 1 "%" '() '() #f #f #f #f #f #f 0 #f))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-for-run-mindata (list 1  "%" '("COMPLETED") '("PASS") #f ))) 0))


(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'delete-test-records (list 1 2 ))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-set-state-status (list 1 1 "COMPLETED" "FAIL" "Another message" ))) 0))


(test #f '() (vector-ref (api:execute-requests my-dbstruct (vector 'get-matching-previous-test-run-records (list 1 "foo" ""))) 1))
(test #f '("/tmp/badname" "logs/final.log") (vector-ref (api:execute-requests my-dbstruct (vector 'test-get-logfile-info (list 1 "foo"))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-get-records-for-index-file (list 1 "foo"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-testinfo-state-status (list 1 1))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'general-call (list 'test-set-log 1 "/tmp/another/logfile/eh" 1))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-set-archive-block-id (list 1 1 123))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-set-top-process-pid (list 1 1 123))) 0))
︙︙
155
156
157
158
159
160
161













162
163
164
165
166
167
168
169
170
171
172
173
174
175
176

(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'mark-incomplete (list 1 12000))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'no-sync-set (list "field1" "value1"))) 0))
(test #f "value1" (vector-ref (api:execute-requests my-dbstruct (vector 'no-sync-get/default (list "field1" #f))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'no-sync-del! (list "field1"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'no-sync-get-lock (list "mykey"))) 0))
(test #f 1 (vector-ref (api:execute-requests my-dbstruct (vector 'archive-register-disk (list "mydisk" "/usr/mydisk" 10000000))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'archive-register-block-name (list 1 "/usr/mydisk/myblock"))) 0))













;;This api function calls db:archive-allocate-testsuite/area-to-block, which does not exist.
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'archive-allocate-testsuite/area-to-block (list 1 "/usr/mydisk/myblock"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-get-archive-block-info (list 1 ))) 0))

;;debug this: ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: (0 . last_update)
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'sync-inmem->db (list 1))) 0))

;;debug this. Error: bad argument count - received 0 but expected 5: #<procedure (db:get-runs dbstruct3787 runpatt3788 count3789 offset3790 keypatts3...
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'synchash-get (list 1 (db:get-runs) "foo" 1 (list "%" 10 0 keypatts)))) 0))

;;debug this. Call of non-procedure
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'sdb-qry (list "sdb-db"))) 0))

(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'ping (list ))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'kill-server (list ))) 0))








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


<










<
<

149
150
151
152
153
154
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



(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'mark-incomplete (list 1 12000))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'no-sync-set (list "field1" "value1"))) 0))
(test #f "value1" (vector-ref (api:execute-requests my-dbstruct (vector 'no-sync-get/default (list "field1" #f))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'no-sync-del! (list "field1"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'no-sync-get-lock (list "mykey"))) 0))
(test #f 1 (vector-ref (api:execute-requests my-dbstruct (vector 'archive-register-disk (list "mydisk" "/usr/mydisk" 10000000))) 1))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'archive-register-block-name (list 1 "/usr/mydisk/myblock"))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'test-get-archive-block-info (list 1 ))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'ping (list ))) 0))
(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'kill-server (list ))) 0))

;; api.scm calls db:get-previous-test-run-record, which does not exist.
;;(test #f '() (vector-ref (api:execute-requests my-dbstruct (vector "get-previous-test-run-record" (list 1 ))) 1))

;; no such query supported in api.scm, but it is is the list of read-only queries.
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-times (list ))) 0))

;; api.scm calls db:get-tests-for-runs-mindata, which does not exist.
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'get-tests-for-runs-mindata (list 1  "%" '("COMPLETED") '("PASS") #f ))) 0))

;;This api function calls db:archive-allocate-testsuite/area-to-block, which does not exist.
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'archive-allocate-testsuite/area-to-block (list 1 "/usr/mydisk/myblock"))) 0))


;;debug this: ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: (0 . last_update)
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'sync-inmem->db (list 1))) 0))

;;debug this. Error: bad argument count - received 0 but expected 5: #<procedure (db:get-runs dbstruct3787 runpatt3788 count3789 offset3790 keypatts3...
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'synchash-get (list 1 (db:get-runs) "foo" 1 (list "%" 10 0 keypatts)))) 0))

;;debug this. Call of non-procedure
;;(test #f #t (vector-ref (api:execute-requests my-dbstruct (vector 'sdb-qry (list "sdb-db"))) 0))

This page was generated in about 0.119s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00