| ︙ | | |
15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
+
|
(import (prefix base64 base64:))
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(define help (conc "
Megatest, documentation at http://www.kiatoa.com/fossils/megatest
|
| ︙ | | |
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
+
|
-rollup : fill run (set by :runname) with latest test(s) from
prior runs with same keys
-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.
-archive : archive tests, use -target, :runname, -itempatt and -testpatt
-server : start the server (reduces contention on megatest.db)
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
|
| ︙ | | |
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
+
+
|
"-runall" ;; run all tests
"-remove-runs"
"-keepgoing"
"-usequeue"
"-rebuild-db"
"-rollup"
"-update-meta"
"-server"
"-v" ;; verbose 2, more than normal (normal is 1)
"-q" ;; quiet 0, errors/warnings only
)
args:arg-hash
0))
(if (args:get-arg "-h")
|
| ︙ | | |
377
378
379
380
381
382
383
384
385
386
387
388
389
390
|
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
|
+
+
+
+
+
+
+
+
+
+
|
runname
(args:get-arg "-runtests")
(args:get-arg "-itempatt")
user
(make-hash-table)))))
;;======================================================================
;; Start the server
;;======================================================================
(if (args:get-arg "-server")
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(if db
(server:start db)
(debug:print 0 "ERROR: Failed to setup for megatest"))))
;;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
(general-run-call
"-rollup"
"rollup tests"
(lambda (db keys keynames keyvallst)
|
| ︙ | | |
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
|
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
|
-
+
|
(change-directory testpath)
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(if (and state status)
(teststep-set-status! db run-id test-name step state status itemdat (args:get-arg "-m") logfile)
(rdb:teststep-set-status! db run-id test-name step state status itemdat (args:get-arg "-m") logfile)
(begin
(debug:print 0 "ERROR: You must specify :state and :status with every call to -step")
(exit 6)))
(sqlite3:finalize! db)
(set! *didsomething* #t))))
(if (or (args:get-arg "-setlog") ;; since setting up is so costly lets piggyback on -test-status
|
| ︙ | | |
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
|
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
|
-
+
|
(redir (case (string->symbol shell)
((tcsh csh ksh) ">&")
((zsh bash sh ash) "2>&1 >")))
(fullcmd (conc "(" (string-intersperse
(cons cmd params) " ")
") " redir " " logfile)))
;; mark the start of the test
(teststep-set-status! db run-id test-name stepname "start" "n/a" itemdat (args:get-arg "-m") logfile)
(rdb:teststep-set-status! db run-id test-name stepname "start" "n/a" itemdat (args:get-arg "-m") logfile)
;; close the db
(sqlite3:finalize! db)
;; run the test step
(debug:print 2 "INFO: Running \"" fullcmd "\"")
(change-directory startingdir)
(set! exitstat (system fullcmd)) ;; cmd params))
(set! *globalexitstatus* exitstat)
|
| ︙ | | |
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
|
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
|
-
+
|
(cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
(debug:print 2 "INFO: running \"" cmd "\"")
(change-directory startingdir)
(set! exitstat (system cmd))
(set! *globalexitstatus* exitstat) ;; no necessary
(change-directory testpath)
(test-set-log! db run-id test-name itemdat htmllogfile)))
(teststep-set-status! db run-id test-name stepname "end" exitstat itemdat (args:get-arg "-m") logfile)
(rdb:teststep-set-status! db run-id test-name stepname "end" exitstat itemdat (args:get-arg "-m") logfile)
(sqlite3:finalize! db)
(if (not (eq? exitstat 0))
(exit 254)) ;; (exit exitstat) doesn't work?!?
;; open the db
;; mark the end of the test
)))
(if (or (args:get-arg "-test-status")
|
| ︙ | | |