Megatest

Check-in [b5bfe140e0]
Login
Overview
Comment:Moved setting of various env vars to earlier point in time so they are available when the testconfig file is read. This means you can use MT_RUNNAME, MT_TEST_NAME etc. in [system .../some/script] calls
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | v1.08
Files: files | file ages | folders
SHA1: b5bfe140e0d99d3f9047b7faae59d259f6d040a2
User & Date: matt on 2011-05-23 23:35:19
Other Links: manifest | tags
Context
2011-05-25
08:53
env-overrides now carry over into the test environment. change to toppath before reading of megatest.config so any evaluated relative paths consistently start at toppath check-in: 5c3fd5b583 user: mrwellan tags: trunk
2011-05-23
23:35
Moved setting of various env vars to earlier point in time so they are available when the testconfig file is read. This means you can use MT_RUNNAME, MT_TEST_NAME etc. in [system .../some/script] calls check-in: b5bfe140e0 user: matt tags: trunk, v1.08
2011-05-18
00:00
Added setting of env. vars prior to test launch. Bumping to 1.08 check-in: 0d6213c6ea user: matt tags: trunk
Changes

Modified megatest.scm from [7cb2676ef1] to [1b697bd36b].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
;; Copyright 2006-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

(include "common.scm")
(define megatest-version 1.08)

(define help (conc "
Megatest, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright Matt Welland 2006-2011

Usage: megatest [options]










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
;; Copyright 2006-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

(include "common.scm")
(define megatest-version 1.09)

(define help (conc "
Megatest, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright Matt Welland 2006-2011

Usage: megatest [options]

Modified runs.scm from [1b01ab0bb7] to [a0a9838068].

244
245
246
247
248
249
250



251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267





268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
    (for-each (lambda (testpath)
		(if (file-exists? (conc testpath "/testconfig"))
		    (set! res (cons (last (string-split testpath "/")) res))))
	      tests)
    res))

(define (run-tests db test-names)



  (for-each 
   (lambda (test-name)
     (let ((num-running (db:get-count-tests-running db))
	   (max-concurrent-jobs (config-lookup *configdat* "setup" "max_concurrent_jobs")))
       (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
       (if (or (not max-concurrent-jobs)
	       (and max-concurrent-jobs
		    (string->number max-concurrent-jobs)
		    (not (> num-running (string->number max-concurrent-jobs)))))
	   (run-one-test db test-name)
	   (print "WARNING: Max running jobs exceeded, current number running: " num-running 
		  ", max_concurrent_jobs: " max-concurrent-jobs))))
   test-names))

;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc
(define (run-one-test db test-name)
  (print "Launching test " test-name)





  (let* ((test-path    (conc *toppath* "/tests/" test-name))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (test-conf    (if testexists (read-config test-configf) (make-hash-table)))
	 (waiton       (let ((w (config-lookup test-conf "requirements" "waiton")))
			 (if (string? w)(string-split w)'()))))
    (if (not testexists)
	(begin
	  (print "ERROR: Can't find config file " test-configf)
	  (exit 2))
	;; put top vars into convenient variables and open the db
	(let* (;; db is always at *toppath*/db/megatest.db
	       (keys        (db-get-keys db))
	       (keyvallst   (keys->vallist keys #t))
	       (items       (hash-table-ref/default test-conf "items" #f))
	       (allitems    (item-assoc->item-list items))
	       (run-id      (register-run db keys)) ;;  test-name)))
	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
	  ;; (print "items: ")(pp allitems)
	  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
	  (if (args:get-arg "-m")
	      (db:set-comment-for-run db run-id (args:get-arg "-m")))
	  (let loop ((itemdat (car allitems))
		     (tal     (cdr allitems)))
	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))







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


|

>
>
>
>
>












<
<


<


<







244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287


288
289

290
291

292
293
294
295
296
297
298
    (for-each (lambda (testpath)
		(if (file-exists? (conc testpath "/testconfig"))
		    (set! res (cons (last (string-split testpath "/")) res))))
	      tests)
    res))

(define (run-tests db test-names)
  (let* ((keys        (db-get-keys db))
	 (keyvallst   (keys->vallist keys #t))
	 (run-id      (register-run db keys))) ;;  test-name)))
    (for-each 
     (lambda (test-name)
       (let ((num-running (db:get-count-tests-running db))
	     (max-concurrent-jobs (config-lookup *configdat* "setup" "max_concurrent_jobs")))
	 (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
	 (if (or (not max-concurrent-jobs)
		 (and max-concurrent-jobs
		      (string->number max-concurrent-jobs)
		      (not (> num-running (string->number max-concurrent-jobs)))))
	     (run-one-test db run-id test-name keyvallst)
	     (print "WARNING: Max running jobs exceeded, current number running: " num-running 
		    ", max_concurrent_jobs: " max-concurrent-jobs))))
     test-names)))

;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc
(define (run-one-test db run-id test-name keyvallst)
  (print "Launching test " test-name)
  ;; All these vars might be referenced by the testconfig file reader
  (setenv "MT_TEST_NAME" test-name) ;; 
  (setenv "MT_RUNNAME"   (args:get-arg ":runname"))
  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
  (change-directory *toppath*)
  (let* ((test-path    (conc *toppath* "/tests/" test-name))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (test-conf    (if testexists (read-config test-configf) (make-hash-table)))
	 (waiton       (let ((w (config-lookup test-conf "requirements" "waiton")))
			 (if (string? w)(string-split w)'()))))
    (if (not testexists)
	(begin
	  (print "ERROR: Can't find config file " test-configf)
	  (exit 2))
	;; put top vars into convenient variables and open the db
	(let* (;; db is always at *toppath*/db/megatest.db


	       (items       (hash-table-ref/default test-conf "items" #f))
	       (allitems    (item-assoc->item-list items))

	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
	  ;; (print "items: ")(pp allitems)

	  (if (args:get-arg "-m")
	      (db:set-comment-for-run db run-id (args:get-arg "-m")))
	  (let loop ((itemdat (car allitems))
		     (tal     (cdr allitems)))
	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))

Modified tests/tests/sqlitespeed/testconfig from [6423a0c21d] to [bda216d037].

1
2
3
4
5
6
7
8
9
10
11
[setup]
runscript runscript.rb

[requirements]
waiton    runfirst

[items]
MANYITEMS [system ls]
# a b c d e f g h i j k l m
# LSJUNK [system ls]








|



1
2
3
4
5
6
7
8
9
10
11
[setup]
runscript runscript.rb

[requirements]
waiton    runfirst

[items]
MANYITEMS [system (env > envfile.txt;ls)]
# a b c d e f g h i j k l m
# LSJUNK [system ls]