Megatest

Check-in [58eba43a32]
Login
Overview
Comment:Fixed bug in -show-config and -show-runconfig and added json output
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: 58eba43a325690344b655e98b5b89ebf20f8f666
User & Date: mrwellan on 2013-03-11 14:36:41
Other Links: branch diff | manifest | tags
Context
2013-03-11
15:08
For -reqtarg we need to allow system in runconfigs parsing or we won't see some runs Leaf check-in: a034278830 user: mrwellan tags: dev
14:36
Fixed bug in -show-config and -show-runconfig and added json output check-in: 58eba43a32 user: mrwellan tags: dev
2013-03-10
18:41
Completed move of functions to client.scm check-in: 643c26a524 user: matt tags: dev
Changes

Modified megatest.scm from [5372a37012] to [e6e640b809].

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

14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20












-
+







;; Copyright 2006-2012, 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")
;; (include "megatest-version.scm")

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format readline apropos ) ;; (srfi 18) extras)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format readline apropos json) ;; (srfi 18) extras)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

(use zmq)

(declare (uses common))
(declare (uses megatest-version))
92
93
94
95
96
97
98

99
100
101
102
103
104
105
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106







+







  -test-paths             : get the test paths matching target, runname, item and test
                            patterns.
  -list-disks             : list the disks available for storing runs
  -list-targets           : list the targets in runconfigs.config
  -list-db-targets        : list the target combinations used in the db
  -show-config            : dump the internal representation of the megatest.config file
  -show-runconfig         : dump the internal representation of the runconfigs.config file
  -dumpmode json          : dump in json format instead of sexpr

Misc 
  -rebuild-db             : bring the database schema up to date
  -update-meta            : update the tests metadata for all tests
  -env2file fname         : write the environment to fname.csh and fname.sh
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
178
179
180
181
182
183
184

185
186
187
188
189
190
191
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193







+







			"-setvars"
			"-set-state-status"
			"-debug" ;; for *verbosity* > 2
			"-gen-megatest-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-dumpmode"
			) 
		 (list  "-h"
			"-version"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"
345
346
347
348
349
350
351







352

353


354





355
356
357
358

359


360





361
362
363
364
365
366
367
347
348
349
350
351
352
353
354
355
356
357
358
359
360

361
362
363
364

365
366
367
368
369
370
371
372

373
374
375
376

377
378
379
380
381
382
383
384
385
386
387
388







+
+
+
+
+
+
+
-
+

+
+
-
+
+
+
+
+



-
+

+
+
-
+
+
+
+
+







      (for-each (lambda (x)
		  ;; (print "[" x "]"))
		  (print x))
		targets)
      (set! *didsomething* #t)))

(if (args:get-arg "-show-runconfig")
    (let* ((target (if (args:get-arg "-reqtarg")
		       (args:get-arg "-reqtarg")
		       (if (args:get-arg "-target")
			   (args:get-arg "-target")
			   #f)))
	   (sections (if target (list "default" target) #f))
	   (data     (read-config "runconfigs.config" #f #f sections: sections)))
    (begin

      ;; keep this one local
      (cond
       ((not (args:get-arg "-dumpmode"))
      (pp (hash-table->alist (open-run-close setup-env-defaults #f "runconfigs.config" #f #f change-env: #f)))
	(pp (hash-table->alist data)))
       ((string=? (args:get-arg "-dumpmode") "json")
	(json-write data))
       (else
	(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
      (set! *didsomething* #t)))

(if (args:get-arg "-show-config")
    (begin
    (let ((data (read-config "megatest.config" #f #f)))
      ;; keep this one local
      (cond 
       ((not (args:get-arg "-dumpmode"))
      (pp (hash-table->alist (open-run-close setup-env-defaults #f "megatest.config" #f #f change-env: #f)))
	(pp (hash-table->alist data)))
       ((string=? (args:get-arg "-dumpmode") "json")
	(json-write data))
       (else
	(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
      (set! *didsomething* #t)))

;;======================================================================
;; Remove old run(s)
;;======================================================================

;; since several actions can be specified on the command line the removal