255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
(save-environment-as-files (args:get-arg "-env2file"))
(set! *didsomething* #t)))
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
(server:launch)
(server:client-launch))
;;======================================================================
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
|
>
|
>
>
>
>
>
>
>
>
>
|
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
|
(save-environment-as-files (args:get-arg "-env2file"))
(set! *didsomething* #t)))
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
(server:launch))
(if (or (let ((res #f))
(for-each
(lambda (key)
(if (args:get-arg key)(set! res #t)))
(list "-h" "-version" "-gen-megatest-area" "-gen-megatest-test"))
res)
(eq? (length (hash-table-keys args:arg-hash)) 0))
(debug:print-info 1 "No server needed")
(server:client-launch))
;;======================================================================
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
|
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
|
(server:client-setup)
(if (args:get-arg "-load-test-data")
;; has sub commands that are rdb:
(open-run-close db:load-test-data db test-id))
(if (args:get-arg "-setlog")
(let ((logfname (args:get-arg "-setlog")))
(open-run-close db:test-set-log! db test-id logfname)))
(if (args:get-arg "-set-toplog")
(open-run-close tests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
(if (args:get-arg "-summarize-items")
(open-run-close tests:summarize-items db run-id test-name #t)) ;; do force here
(if (args:get-arg "-runstep")
(if (null? remargs)
(begin
|
|
|
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
|
(server:client-setup)
(if (args:get-arg "-load-test-data")
;; has sub commands that are rdb:
(open-run-close db:load-test-data db test-id))
(if (args:get-arg "-setlog")
(let ((logfname (args:get-arg "-setlog")))
(cdb:test-set-log! *runremote* test-id logfname)))
(if (args:get-arg "-set-toplog")
(open-run-close tests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
(if (args:get-arg "-summarize-items")
(open-run-close tests:summarize-items db run-id test-name #t)) ;; do force here
(if (args:get-arg "-runstep")
(if (null? remargs)
(begin
|
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
|
(oldexitstat exitstat)
(cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
(debug:print-info 2 "running \"" cmd "\"")
(change-directory startingdir)
(set! exitstat (system cmd))
(set! *globalexitstatus* exitstat) ;; no necessary
(change-directory testpath)
(open-run-close db:test-set-log! db test-id htmllogfile)))
(let ((msg (args:get-arg "-m")))
(open-run-close db:teststep-set-status! db test-id stepname "end" exitstat msg logfile))
)))
(if (or (args:get-arg "-test-status")
(args:get-arg "-set-values"))
(let ((newstatus (cond
((number? status) (if (equal? status 0) "PASS" "FAIL"))
|
|
|
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
|
(oldexitstat exitstat)
(cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
(debug:print-info 2 "running \"" cmd "\"")
(change-directory startingdir)
(set! exitstat (system cmd))
(set! *globalexitstatus* exitstat) ;; no necessary
(change-directory testpath)
(cdb:test-set-log! *runremote* test-id htmllogfile)))
(let ((msg (args:get-arg "-m")))
(open-run-close db:teststep-set-status! db test-id stepname "end" exitstat msg logfile))
)))
(if (or (args:get-arg "-test-status")
(args:get-arg "-set-values"))
(let ((newstatus (cond
((number? status) (if (equal? status 0) "PASS" "FAIL"))
|