Megatest

Check-in [35bbab5179]
Login
Overview
Comment:Added test for basic filter operation on rmt:get-tests-for-run
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | filters-fix
Files: files | file ages | folders
SHA1: 35bbab5179c5d115291f6b9f2c2b9aa5264e6b91
User & Date: mrwellan on 2016-06-20 11:35:14
Other Links: branch diff | manifest | tags
Context
2016-06-20
18:20
Filter mostly fixed and added unit test for filter Closed-Leaf check-in: 1d19de5e2c user: mrwellan tags: filters-fix
11:35
Added test for basic filter operation on rmt:get-tests-for-run check-in: 35bbab5179 user: mrwellan tags: filters-fix
2016-06-17
17:40
Auto compile for correct readline version check-in: b71c8dd554 user: mrwellan tags: filters-fix
Changes

Modified common.scm from [49cb5d370b] to [8d66db977f].

150
151
152
153
154
155
156


157








158

159



160
161
162
163













164
165
166
167
168
169
170
171
172
(define (common:set-last-run-version)
  (rmt:set-var "MEGATEST_VERSION" (common:version-signature)))

(define (common:version-changed?)
  (not (equal? (common:get-last-run-version)
	       (common:version-signature))))



(define (common:exit-on-version-changed)








  (if (common:version-changed?)

      (begin



	(debug:print 0
		     "ERROR: Version mismatch!\n"
		     "   expected: " (common:version-signature) "\n"
		     "   got:      " (common:get-last-run-version) "\n"













		     " to switch versions you can run: \"megatest -cleanup-db\"")
	(exit 1))))

;;======================================================================
;; S P A R S E   A R R A Y S
;;======================================================================

(define (make-sparse-array)
  (let ((a (make-sparse-vector)))







>
>
|
>
>
>
>
>
>
>
>

>
|
>
>
>
|


|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|







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
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
(define (common:set-last-run-version)
  (rmt:set-var "MEGATEST_VERSION" (common:version-signature)))

(define (common:version-changed?)
  (not (equal? (common:get-last-run-version)
	       (common:version-signature))))

;; Move me elsewhere ...
;;
(define (common:cleanup-db)
  (db:multi-db-sync 
   #f ;; do all run-ids
   ;; 'new2old
   'killservers
   'dejunk
   ;; 'adj-testids
   ;; 'old2new
   'new2old)
  (if (common:version-changed?)
      (common:set-last-run-version)))

(define (common:exit-on-version-changed)
  (if (common:version-changed?)
      (let ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config")))
	(debug:print 0 
		     "ERROR: Version mismatch!\n"
		     "   expected: " (common:version-signature) "\n"
		     "   got:      " (common:get-last-run-version))
	(if (and (file-exists? mtconf)
		 (eq? (current-user-id)(file-owner mtconf))) ;; safe to run -cleanup-db
	    (begin
	      (debug:print 0 "   I see you are the owner of megatest.config, attempting to cleanup and reset to new version")
	      (handle-exceptions
	       exn
	       (begin
		 (debug:print 0 "Failed to switch versions.")
		 (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
		 (print-call-chain (current-error-port))
		 (exit 1))
	       (common:cleanup-db)))
	    (begin
	      (debug:print 0 " to switch versions you can run: \"megatest -cleanup-db\"")
	      (exit 1))))))

;;======================================================================
;; S P A R S E   A R R A Y S
;;======================================================================

(define (make-sparse-array)
  (let ((a (make-sparse-vector)))

Modified megatest.scm from [2aeb6b6eb4] to [2d27cbb884].

1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850

(if (args:get-arg "-cleanup-db")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      ;; keep this one local
      ;; (open-run-close db:clean-up #f)
      (db:multi-db-sync 
       #f ;; do all run-ids
       ;; 'new2old
       'killservers
       'dejunk
       ;; 'adj-testids
       ;; 'old2new
       'new2old
       )
      (if (common:version-changed?)
	  (common:set-last-run-version))
      (set! *didsomething* #t)))

(if (args:get-arg "-mark-incompletes")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting")







<
<
<
<
<
<
<
<
<
<
<
|
<







1824
1825
1826
1827
1828
1829
1830











1831

1832
1833
1834
1835
1836
1837
1838

(if (args:get-arg "-cleanup-db")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))











      (common:cleanup-db)

      (set! *didsomething* #t)))

(if (args:get-arg "-mark-incompletes")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting")

Modified tests/unittests/basicserver.scm from [f2f7d0aa9d] to [4c3ddd6951].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
;;======================================================================
;; S E R V E R
;;======================================================================

;; Run like this:
;;
;;  ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)

(delete-file* "logs/1.log")
(define run-id 1)

(test "setup for run" #t (begin (launch:setup-for-run)
 				(string? (getenv "MT_RUN_AREA_HOME"))))

;; NON Server tests go here

(test #f #f (db:dbdat-get-path *db*))
(test #f #f (db:get-run-name-from-id *db* run-id))
;; (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
;;======================================================================
;; S E R V E R
;;======================================================================

;; Run like this:
;;
;;  ./rununittest.sh server 1;(cd simplerun;megatest -stop-server 0)

(delete-file* "logs/1.log")
(define run-id 1)

(test "setup for run" #t (begin (launch:setup)
 				(string? (getenv "MT_RUN_AREA_HOME"))))

;; NON Server tests go here

(test #f #f (db:dbdat-get-path *db*))
(test #f #f (db:get-run-name-from-id *db* run-id))
;; (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))

Modified tests/unittests/tests.scm from [15fd3688ae] to [4797bdd618].

1
2
3
4
5
6
7
8
9
10
11
12
13


































;;======================================================================
;; itemwait, itemmatch

(db:compare-itempaths ref-item-path item-path itemmap)

;; prereqs-not-met

(rmt:get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))

	 (fails           (runs:calc-fails prereqs-not-met))
	 (prereq-fails    (runs:calc-prereq-fail prereqs-not-met))
	 (non-completed   (runs:calc-not-completed prereqs-not-met))
	 (runnables       (runs:calc-runnable prereqs-not-met)))


































|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;; ;;======================================================================
;; ;; itemwait, itemmatch
;; 
;; (db:compare-itempaths ref-item-path item-path itemmap)
;; 
;; ;; prereqs-not-met
;; 
;; (rmt:get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
;; 
;; 	 (fails           (runs:calc-fails prereqs-not-met))
;; 	 (prereq-fails    (runs:calc-prereq-fail prereqs-not-met))
;; 	 (non-completed   (runs:calc-not-completed prereqs-not-met))
;; 	 (runnables       (runs:calc-runnable prereqs-not-met)))
;; 
;; 
;; 

(define user    (current-user-name))
(define runname "mytestrun")
(define keys    (rmt:get-keys))
(define runinfo #f)
(define keyvals '(("SYSTEM" "abc")("RELEASE" "def")))
(define header  (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time"))
(define run-id  1)

;; Create a run
(test #f 1 (rmt:register-run keyvals runname "new" "n/a" user))
(test #f #t (rmt:general-call 'register-test run-id run-id "test-one" ""))
(test #f #t (rmt:general-call 'register-test run-id run-id "test-two" ""))

(rmt:test-set-state-status-by-id 
 run-id
 (rmt:get-test-id run-id "test-one" "") "COMPLETED" "FAIL" "")
(rmt:test-set-state-status-by-id 
 run-id
 (rmt:get-test-id run-id "test-two" "") "COMPLETED" "PASS" "")

(test #f '("FAIL")
      (map 
       (lambda (x)(vector-ref x 4))
       (rmt:get-tests-for-run run-id "%/%" '() '("FAIL") #f #f #t 'event_time "DESC" 'shortlist 0 'dashboard)))
(test #f '()
      (map 
       (lambda (x)(vector-ref x 4))
       (rmt:get-tests-for-run run-id "%/%" '() '("FAIL") #f #f #f 'event_time "DESC" 'shortlist 0 'dashboard)))

(exit)