Megatest

Diff
Login

Differences From Artifact [7edaf0bfca]:

To Artifact [4e1718db76]:


17
18
19
20
21
22
23

24
25
26
27
28
29
30
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses tests))


(define *db* #f) ;; this is only for the repl, do not use in general!!!!

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")








>







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses tests))
(declare (uses genexample))

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")

71
72
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
105
106

107
108
109
110
111
112
113
114
115
116
117
118
  -set-values             : update or set values in the testdata table
  :category               : set the category field (optional)
  :variable               : set the variable name (optional)
  :value                  : value measured (required)
  :expected               : value expected (required)
  :tol                    : |value-expect| <= tol (required, can be <, >, >=, <= or number)
  :units                  : name of the units for value, expected_value etc. (optional)

  -load-test-data         : read test specific data for storage in the test_data table
                            from standard in. Each line is comma delimited with four
                            fields category,variable,value,comment

Queries
  -list-runs patt         : list runs matching pattern \"patt\", % is the wildcard
  -showkeys               : show the keys used in this megatest setup
  -test-paths targpatt    : get the most recent test path(s) matching targpatt e.g. %/%... 
                            returns list sorted by age ascending, see examples below

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.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -repl                   : start a repl (useful for extending megatest)

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style

Helpers (these only apply in test run mode)


Examples

# Get test paths 
megatest -test-paths -target ubuntu/n%/no% :runname w49% -testpatt test_mt%

Called as " (string-intersperse (argv) " ")))

;;  -gui                    : start a gui interface
;;  -config fname           : override the runconfig file with fname

;; process args







<







|


















|
|
>



|
|







72
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
  -set-values             : update or set values in the testdata table
  :category               : set the category field (optional)
  :variable               : set the variable name (optional)
  :value                  : value measured (required)
  :expected               : value expected (required)
  :tol                    : |value-expect| <= tol (required, can be <, >, >=, <= or number)
  :units                  : name of the units for value, expected_value etc. (optional)

  -load-test-data         : read test specific data for storage in the test_data table
                            from standard in. Each line is comma delimited with four
                            fields category,variable,value,comment

Queries
  -list-runs patt         : list runs matching pattern \"patt\", % is the wildcard
  -showkeys               : show the keys used in this megatest setup
  -test-path targpatt    : get the most recent test path(s) matching targpatt e.g. %/%... 
                            returns list sorted by age ascending, see examples below

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.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -repl                   : start a repl (useful for extending megatest)

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style
Getting started
  -gen-megatest-area      : create a skeleton megatest area. You will be prompted for paths
  -gen-megatest-test      : create a skeleton megatest test. You will be prompted for info

Examples

# Get test path, the '.' is required, could use '*' or a specific path/file
megatest -test-path . -target ubuntu/n%/no% :runname w49% -testpatt test_mt%

Called as " (string-intersperse (argv) " ")))

;;  -gui                    : start a gui interface
;;  -config fname           : override the runconfig file with fname

;; process args
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
			"-server"
			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-setvars"
			"-set-state-status"
			"-debug" ;; for *verbosity* > 2

			"-override-timeout"
			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"
			"-set-values"
			"-load-test-data"
			"-summarize-items"
		        "-gui"
			;; misc
			"-archive"
			"-repl"
			"-lock"
			"-unlock"
			;; queries
			"-test-paths" ;; get path(s) to a test, ordered by youngest first


			"-runall"    ;; run all tests
			"-remove-runs"
			"-usequeue"
			"-rebuild-db"
			"-rollup"
			"-update-meta"


			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
		       )
		 args:arg-hash
		 0))








>


















>







>







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
			"-server"
			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-setvars"
			"-set-state-status"
			"-debug" ;; for *verbosity* > 2
			"-gen-megatest-test"
			"-override-timeout"
			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"
			"-set-values"
			"-load-test-data"
			"-summarize-items"
		        "-gui"
			;; misc
			"-archive"
			"-repl"
			"-lock"
			"-unlock"
			;; queries
			"-test-paths" ;; get path(s) to a test, ordered by youngest first
			"-test-path"  ;; -test-paths is deprecated

			"-runall"    ;; run all tests
			"-remove-runs"
			"-usequeue"
			"-rebuild-db"
			"-rollup"
			"-update-meta"
			"-gen-megatest-area"

			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
		       )
		 args:arg-hash
		 0))

445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
		  (args:get-arg "-unlock")
		  user))))

;;======================================================================
;; Get paths to tests
;;======================================================================
;; Get test paths matching target, runname, testpatt, and itempatt
(if (args:get-arg "-test-paths")
    ;; if we are in a test use the MT_CMDINFO data
    (if (getenv "MT_CMDINFO")
	(let* ((startingdir (current-directory))
	       (cmdinfo   (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
	       (testpath  (assoc/default 'testpath  cmdinfo))
	       (test-name (assoc/default 'test-name cmdinfo))
	       (runscript (assoc/default 'runscript cmdinfo))







|







449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
		  (args:get-arg "-unlock")
		  user))))

;;======================================================================
;; Get paths to tests
;;======================================================================
;; Get test paths matching target, runname, testpatt, and itempatt
(if (or (args:get-arg "-test-path")(args:get-arg "-test-paths"))
    ;; if we are in a test use the MT_CMDINFO data
    (if (getenv "MT_CMDINFO")
	(let* ((startingdir (current-directory))
	       (cmdinfo   (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
	       (testpath  (assoc/default 'testpath  cmdinfo))
	       (test-name (assoc/default 'test-name cmdinfo))
	       (runscript (assoc/default 'runscript cmdinfo))
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
	  (change-directory testpath)
	  (if (not target)
	      (begin
		(debug:print 0 "ERROR: -target is required.")
		(exit 1)))
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, giving up on -test-paths, exiting")
		(exit 1)))
	  (set! db (open-db))    
	  (if (not (args:get-arg "-server"))
	      (server:client-setup db))
	  (let* ((itempatt (args:get-arg "-itempatt"))
		 (keys     (rdb:get-keys db))
		 (keynames (map key:get-fieldname keys))
		 (paths    (rdb:test-get-paths-matching db keynames target)))
	    (set! *didsomething* #t)
	    (for-each (lambda (path)
			(print path))
		      paths)))
	;; else do a general-run-call
	(general-run-call 
	 "-test-paths"
	 "Get paths to tests"
	 (lambda (db target runname keys keynames keyvallst)
	   (let* ((itempatt (args:get-arg "-itempatt"))
		  (paths    (rdb:test-get-paths-matching db keynames target)))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))








|














|
|







471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
	  (change-directory testpath)
	  (if (not target)
	      (begin
		(debug:print 0 "ERROR: -target is required.")
		(exit 1)))
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, giving up on -test-path, exiting")
		(exit 1)))
	  (set! db (open-db))    
	  (if (not (args:get-arg "-server"))
	      (server:client-setup db))
	  (let* ((itempatt (args:get-arg "-itempatt"))
		 (keys     (rdb:get-keys db))
		 (keynames (map key:get-fieldname keys))
		 (paths    (rdb:test-get-paths-matching db keynames target)))
	    (set! *didsomething* #t)
	    (for-each (lambda (path)
			(print path))
		      paths)))
	;; else do a general-run-call
	(general-run-call 
	 "-test-path"
	 "Get paths to test"
	 (lambda (db target runname keys keynames keyvallst)
	   (let* ((itempatt (args:get-arg "-itempatt"))
		  (paths    (rdb:test-get-paths-matching db keynames target)))
	     (for-each (lambda (path)
			 (print path))
		       paths))))))

753
754
755
756
757
758
759










760
761
762
763
764
765
766
      (set! *didsomething* #t)))

(if (args:get-arg "-gui")
    (begin
      (debug:print 0 "Look at the dashboard for now")
      ;; (megatest-gui)
      (set! *didsomething* #t)))











;;======================================================================
;; Update the database schema on request
;;======================================================================

(if (args:get-arg "-rebuild-db")
    (begin







>
>
>
>
>
>
>
>
>
>







757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
      (set! *didsomething* #t)))

(if (args:get-arg "-gui")
    (begin
      (debug:print 0 "Look at the dashboard for now")
      ;; (megatest-gui)
      (set! *didsomething* #t)))

(if (args:get-arg "-gen-megatest-area")
    (begin
      (genexample:mk-megatest.config)
      (set! *didsomething* #t)))

(if (args:get-arg "-gen-megatest-test")
    (let ((testname (args:get-arg "-gen-megatest-test")))
      (genexample:mk-megatest-test testname)
      (set! *didsomething* #t)))

;;======================================================================
;; Update the database schema on request
;;======================================================================

(if (args:get-arg "-rebuild-db")
    (begin