| ︙ | | | ︙ | |
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
;; misc
"-server"
"-extract-ods"
"-pathmod"
"-env2file"
"-setvars"
"-debug" ;; for *verbosity* > 2
)
(list "-h"
"-force"
"-xterm"
"-showkeys"
"-test-status"
"-set-values"
|
>
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
;; misc
"-server"
"-extract-ods"
"-pathmod"
"-env2file"
"-setvars"
"-debug" ;; for *verbosity* > 2
"-override-timeout"
)
(list "-h"
"-force"
"-xterm"
"-showkeys"
"-test-status"
"-set-values"
|
| ︙ | | | ︙ | |
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
|
(if (and (args:get-arg "-server")
(not (or (args:get-arg "-runall")
(args:get-arg "-runtests"))))
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(debug:print 0 "INFO: Starting the standalone server")
(if db
(let ((th2 (server:start db (args:get-arg "-server"))))
(thread-join! th2))
(debug:print 0 "ERROR: Failed to setup for megatest"))))
;;======================================================================
;; full run
;;======================================================================
;; get lock in db for full run for this directory
|
>
|
>
>
>
|
|
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
|
(if (and (args:get-arg "-server")
(not (or (args:get-arg "-runall")
(args:get-arg "-runtests"))))
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(debug:print 0 "INFO: Starting the standalone server")
(if db
(let* ((host:port (db:get-var "SERVER")) ;; this doen't support multiple servers BUG!!!!
(th2 (server:start db (args:get-arg "-server")))
(th3 (lambda ()
(server:keep-going db))))
(thread-start! th3)
(thread-join! th3))
(debug:print 0 "ERROR: Failed to setup for megatest"))))
;;======================================================================
;; full run
;;======================================================================
;; get lock in db for full run for this directory
|
| ︙ | | | ︙ | |
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
|
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(if (not (args:get-arg "-server"))
(server:client-setup db))
(if (args:get-arg "-load-test-data")
;; has sub commands that are rdb:
(db:load-test-data db run-id test-name itemdat))
(if (args:get-arg "-setlog")
(rdb:test-set-log! db run-id test-name itemdat (args:get-arg "-setlog")))
(if (args:get-arg "-set-toplog")
(rdb:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
(if (args:get-arg "-summarize-items")
(rdb:tests:summarize-items db run-id test-name #t)) ;; do force here
(if (args:get-arg "-runstep")
(if (null? remargs)
(begin
|
|
|
|
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
|
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! db (open-db))
(if (not (args:get-arg "-server"))
(server:client-setup db))
(if (args:get-arg "-load-test-data")
;; has sub commands that are rdb:
(db:load-test-data db test-id))
(if (args:get-arg "-setlog")
(rdb:test-set-log! db test-id (args:get-arg "-setlog")))
(if (args:get-arg "-set-toplog")
(rdb:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
(if (args:get-arg "-summarize-items")
(rdb:tests:summarize-items db run-id test-name #t)) ;; do force here
(if (args:get-arg "-runstep")
(if (null? remargs)
(begin
|
| ︙ | | | ︙ | |
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
|
(oldexitstat exitstat)
(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)
(rdb:test-set-log! db run-id test-name itemdat htmllogfile)))
(rdb:teststep-set-status! db test-id 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
)))
|
|
|
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
|
(oldexitstat exitstat)
(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)
(rdb:test-set-log! db test-id htmllogfile)))
(rdb:teststep-set-status! db test-id 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
)))
|
| ︙ | | | ︙ | |