Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -1760,35 +1760,22 @@
(if (and (null? incompleted)
(null? oldlaunched)
(null? toplevels))
#f
#t)))))
-
-;; given a launch delay (minimum time from last launch) return amount of time to wait
-;;
-;; (define (db:launch-delay-left dbstruct run-id launch-delay)
-
-
(define (db:get-status-from-final-status-file run-dir)
- (let (
- (infile (conc run-dir "/.final-status")))
-
- ;; first verify we are able to write the output file
- (if (not (file-read-access? infile))
- (begin
- (debug:print 0 *default-log-port* "ERROR: cannot read " infile)
+ (let ((infile (conc run-dir "/.final-status")))
+ ;; first verify we are able to write the output file
+ (if (not (file-read-access? infile))
+ (begin
+ (debug:print 0 *default-log-port* "ERROR: cannot read " infile)
(debug:print 0 *default-log-port* "ERROR: run-dir is " run-dir)
#f
)
- (with-input-from-file infile read-lines)
- )
- )
-)
-
-
-
+ (with-input-from-file infile read-lines)
+ )))
;; select end_time-now from
;; (select testname,item_path,event_time+run_duration as
;; end_time,strftime('%s','now') as now from tests where state in
;; ('RUNNING','REMOTEHOSTSTART','LAUNCHED'));
Index: genexample.scm
==================================================================
--- genexample.scm
+++ genexample.scm
@@ -17,11 +17,13 @@
;; along with Megatest. If not, see .
;;======================================================================
(declare (unit genexample))
-(use posix regex)
+(use posix regex matchable)
+
+(include "db_records.scm")
(define genexample:example-logpro
#<seconds str)
+ (let* ((parts (string-split str))
+ (res 0))
+ (for-each
+ (lambda (part)
+ (set! res
+ (+ res
+ (match (string-match "(\\d+)([a-z])" part)
+ ((_ val units)(* (string->number val)(case (string->symbol units)
+ ((s) 1)
+ ((m) 60)
+ ((h) 3600))))
+ (else 0)))))
+ parts)
+ res))
+
+;; generate a skeleton Megatest area from a current area with runs
+;;
+;; specify target, runname etc to use specific runs for the template
+;;
+(define (genexample:extract-skeleton-area dest-path)
+ (let* ((target (args:get-arg "-target"))
+ (runname (args:get-arg "-runname"))
+ )
+ (if (not (and target runname))
+ (debug:print 0 *default-log-port* "WARNING: For best results please specifiy -target and -runname for a good run to use as a template."))
+ (if (not (and (file-exists? "megatest.config")
+ (file-exists? "megatest.db")))
+ (begin
+ (debug:print 0 *default-log-port* "ERROR: this command must be run at the top level of a megatest area where runs have been completed")
+ (exit)))
+
+ ;; first create the dest path and needed subdirectories
+ (if (not (file-exists? dest-path))
+ (begin
+ (create-directory dest-path)
+ (create-directory (conc dest-path "/tests")))
+ (if (file-exists? (conc dest-path "/megatest.config"))
+ (begin
+ (debug:print 0 *default-log-port* "ERROR: destination path already has megatest.config, stopping now.")
+ (exit))))
+
+ ;; dump the config files from this area to the dest area
+ (system (conc "megatest -show-config > " dest-path "/megatest.config"))
+ (system (conc "megatest -show-runconfig > " dest-path "/runconfigs.config"))
+
+ ;; create a refdb, some stuff has to be done due to refdb not initing area
+ ;; sheet row col value
+ ;; test itempath stepname steptime
+ (if (not (file-exists? (conc dest-path "/stepsinfo")))
+ (begin
+ (create-directory (conc dest-path "/stepsinfo/sxml") #t)
+ (with-output-to-file (conc dest-path "/stepsinfo/sheet-names.cfg") (lambda ()(print)))))
+
+ ;; rmt:get-tests-for-run
+ ;; rmt:get-tests-for-run-mindata run-id testpatt states status not-in
+ ;; rmt:simple-get-runs
+ ;; (define-record simple-run target id runname state status owner event_time)
+ (let* ((runs (rmt:simple-get-runs (or runname "%") #f #f (or target "%")))
+ (tests (make-hash-table))
+ (refdb (conc dest-path "/stepsinfo")))
+ (if (> (length runs) 1)
+ (debug:print-info 0 *default-log-port* "More than one run matches, first found data will be used."))
+ ;; get all testnames
+ (for-each
+ (lambda (run-id)
+ (let* ((tests-data (rmt:get-tests-for-run-mindata run-id "%" '() '() #f)))
+ (for-each
+ (lambda (testdat)
+ (let* ((test-id (db:mintest-get-id testdat))
+ (testname (db:mintest-get-testname testdat))
+ (item-path (db:mintest-get-item_path testdat))
+ ;; now get steps info
+ (test-steps (tests:get-compressed-steps run-id test-id)))
+ (if (not (hash-table-exists? tests testname))
+ (begin
+ (print "\n" testname)
+ (for-each
+ (lambda (teststep)
+ (let* ((step-name (vector-ref teststep 0))
+ (step-duration (hrs-min-sec->seconds (vector-ref teststep 4))))
+ (system (conc "refdb set " refdb " " testname " '" (if (equal? item-path "")
+ "no-item-path"
+ item-path)
+ "' " step-name " " step-duration))
+ ))
+ test-steps))
+ (else (debug:print-info 0 *default-log-port* "Skipping already seen test " testname)))))
+ tests-data)))
+ (map (lambda (runrec)(simple-run-id runrec)) runs)))
+ ))
Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -232,15 +232,13 @@
-dest to set destination), -include path1,path2... to get or save specific files
-generate-html : create a simple html dashboard for browsing your runs
-generate-html-structure : create a top level html veiw to list targets/runs and a Run view within each run directory.
-list-run-time : list time requered to complete runs. It supports following switches
-run-patt -target-patt -dumpmode
- -list-test-time : list time requered to complete each test in a run. It following following arguments
+ -list-test-time : list time requered to complete each test in a run. It following following arguments
-runname -target -dumpmode
-
-
-
+ -extract-skeleton targd : extract a skeleton area based on the current area. Use median step run times.
Diff report
-diff-rep : generate diff report (must include -src-target, -src-runname, -target, -runname
and either -diff-email or -diff-html)
-src-target
@@ -371,10 +369,13 @@
"-diff-email"
"-sync-to"
"-pgsync"
"-kill-wait" ;; wait this long before removing test (default is 10 sec)
"-diff-html"
+
+ ;; wizards, area capture, setup new ...
+ "-extract-skeleton"
)
(list "-h" "-help" "--help"
"-manual"
"-version"
"-force"
@@ -2433,17 +2434,24 @@
(let* ((toppath (launch:setup)))
(if (tests:create-html-tree #f)
(debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/page0.html")
(debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
(set! *didsomething* #t)))
+
(if (args:get-arg "-generate-html-structure")
(let* ((toppath (launch:setup)))
;(if (tests:create-html-tree #f)
(if (tests:create-html-summary #f)
(debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/targets.html")
(debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
(set! *didsomething* #t)))
+
+(if (args:get-arg "-extract-skeleton")
+ (let* ((toppath (launch:setup)))
+ (genexample:extract-skeleton-area (args:get-arg "-extract-skeleton"))
+ (set! *didsomething* #t)))
+
;;======================================================================
;; Exit and clean up
;;======================================================================
(if (not *didsomething*)
Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -2043,11 +2043,11 @@
(debug:print-info 1 *default-log-port* "SKIPPING Test " full-test-name " due to " skip-test))
;;
;; Here the test is handed off to launch.scm for launch-test to complete the launch process
;;
(if (not (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat flags))
- (begin
+ (begin
(print "ERROR: Failed to launch the test. Exiting as soon as possible")
(set! *globalexitstatus* 1) ;;
(process-signal (current-process-id) signal/kill))))))))
((KILLED)
(debug:print 1 *default-log-port* "NOTE: " full-test-name " is already running or was explictly killed, use -force to launch it.")