@@ -15,29 +15,17 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;
;; (include "common.scm")
-;; (include "megatest-version.scm")
+(include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
-(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
- readline apropos json http-client directory-utils typed-records
- http-client srfi-18 extras format)
-
-;; Added for csv stuff - will be removed
-;;
-(use sparse-vectors)
-
-(require-library mutils)
-
-;; (use zmq)
-
(declare (uses common))
-(declare (uses megatest-version))
+;; (declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses client))
@@ -61,10 +49,20 @@
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")
+
+(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
+ readline apropos json http-client directory-utils typed-records
+ http-client srfi-18 extras format)
+
+;; Added for csv stuff - will be removed
+;;
+(use sparse-vectors)
+
+(require-library mutils)
(define *usage-log-file* #f) ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file
;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
@@ -110,11 +108,11 @@
Launching and managing runs
-run : run all tests or as specified by -testpatt
-remove-runs : remove the data for a run, requires -runname and -testpatt
Optionally use :state and :status, use -keep-records to remove only
the run data. Use -kill-wait to override the 10 second
- per test wait after kill delay.
+ per test wait after kill delay (e.g. -kill-wait 0).
-kill-runs : kill existing run(s) (all incomplete tests killed)
-kill-rerun : kill an existing run (all incomplete tests killed and run is rerun)
-set-state-status X,Y : set state to X and status to Y, requires controls per -remove-runs
-rerun FAIL,WARN... : force re-run for tests with specificed status(s)
-rerun-clean : set all tests not COMPLETED+PASS,WARN,WAIVED to NOT_STARTED,n/a
@@ -201,10 +199,12 @@
-update-meta : update the tests metadata for all tests
-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
+ -adjutant C,M : start the server/adjutant with allocated cores C and Mem M (Gig),
+ use 0,0 to auto use full machine
-transport http|rpc : use http or rpc for transport (default is http)
-log logfile : send stdout and stderr to logfile
-list-servers : list the servers
-kill-servers : kill all servers
-repl : start a repl (useful for extending megatest)
@@ -226,19 +226,21 @@
will substitute %s for the sheet name in generating
multiple sheets)
-o : output file for refdb2dat (defaults to stdout)
-archive cmd : archive runs specified by selectors to one of disks specified
in the [archive-disks] section.
- cmd: keep-html, restore, save, save-remove, get,replicate-db (use
+ cmd: keep-html, restore, save, save-remove, get, replicate-db (use
-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
-runname -target -dumpmode
- -extract-skeleton targd : extract a skeleton area based on the current area. Use median step run times.
+ -syscheck : do some very basic checks; write access and space in tmp, home, runs, links and
+ is $DISPLAY valid
+ -list-waivers : dump waivers for specified target, runname, testpatt to stdout
Diff report
-diff-rep : generate diff report (must include -src-target, -src-runname, -target, -runname
and either -diff-email or -diff-html)
-src-target
@@ -251,12 +253,12 @@
-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
- -create-megatest-area : create a skeleton megatest area. You will be prompted for paths
- -create-test testname : create a skeleton megatest test. You will be prompted for info
+ -create-megatest-area : create a skeleton megatest area. You will be prompted for paths
+ -create-test testname : create a skeleton megatest test. You will be prompted for info
Examples
# Get test path, use '.' to get a single path or a specific path/file pattern
megatest -test-files 'logs/*.log' -target ubuntu/n%/no% -runname w49% -testpatt test_mt%
@@ -308,19 +310,21 @@
":variable"
":value"
":expected"
":tol"
":units"
+
;; misc
"-start-dir"
"-run-patt"
"-target-patt"
"-contour"
"-area-tag"
"-area"
"-run-tag"
"-server"
+ "-adjutant"
"-transport"
"-port"
"-extract-ods"
"-pathmod"
"-env2file"
@@ -419,10 +423,11 @@
"-list-db-targets"
"-show-runconfig"
"-show-config"
"-show-cmdinfo"
"-get-run-status"
+ "-list-waivers"
;; queries
"-test-paths" ;; get path(s) to a test, ordered by youngest first
"-runall" ;; run all tests, respects -testpatt, defaults to %
@@ -447,10 +452,11 @@
"-v" ;; verbose 2, more than normal (normal is 1)
"-q" ;; quiet 0, errors/warnings only
"-diff-rep"
+ "-syscheck"
"-obfuscate"
;; junk placeholder
;; "-:p"
)
@@ -503,10 +509,11 @@
(let* ((no-watchdog-args
'("-list-runs"
"-testdata-csv"
"-list-servers"
"-server"
+ "-adjutant"
"-list-disks"
"-list-targets"
"-show-runconfig"
;;"-list-db-targets"
"-show-runconfig"
@@ -896,10 +903,18 @@
(if (args:get-arg "-server")
(let ((tl (launch:setup))
(transport-type (string->symbol (or (args:get-arg "-transport") "http"))))
(server:launch 0 transport-type)
(set! *didsomething* #t)))
+
+;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to
+;; a specific Megatest area. Detail are being hashed out and this may change.
+;;
+(if (args:get-arg "-adjutant")
+ (begin
+ (adjutant-run)
+ (set! *didsomething* #t)))
(if (or (args:get-arg "-list-servers")
(args:get-arg "-kill-servers"))
(let ((tl (launch:setup)))
(if tl ;; all roads from here exit
@@ -1670,20 +1685,50 @@
(set! *time-to-exit* #t)
) ;; end if true branch (end of a let)
) ;; end if
) ;; end if -list-runs
-;; Don't think I need this. Incorporated into -list-runs instead
-;;
-;; (if (and (args:get-arg "-since")
-;; (launch:setup))
-;; (let* ((since-time (string->number (args:get-arg "-since")))
-;; (run-ids (db:get-changed-run-ids since-time)))
-;; ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
-;; (print (sort run-ids <))
-;; (set! *didsomething* #t)))
-
+;; list-waivers
+(if (and (args:get-arg "-list-waivers")
+ (launch:setup))
+ (let* ((runpatt (or (args:get-arg "-runname") "%"))
+ (testpatt (common:args-get-testpatt #f))
+ (keys (rmt:get-keys))
+ (runsdat (rmt:get-runs-by-patt
+ keys runpatt
+ (common:args-get-target) #f #f
+ '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
+ (runs (db:get-rows runsdat))
+ (header (db:get-header runsdat))
+ (results (make-hash-table)) ;; [target] ( (testname/itempath . "comment") ... )
+ (addtest (lambda (target testname itempath comment)
+ (hash-table-set! results target (cons (cons (conc testname "/" itempath) comment)
+ (hash-table-ref/default results target '())))))
+ (last-target #f))
+ (for-each
+ (lambda (run)
+ (let* ((run-id (db:get-value-by-header run header "id"))
+ (target (rmt:get-target run-id))
+ (runname (db:get-value-by-header run header "runname"))
+ (tests (rmt:get-tests-for-run
+ run-id testpatt '("COMPLETED") '("WAIVED") #f #f #f 'testname 'asc ;; use qryvals if test-spec provided
+ #f #f #f)))
+ (if (not (equal? target last-target))
+ (print "[" target "]"))
+ (set! last-target target)
+ (print "# " runname)
+ (for-each
+ (lambda (testdat)
+ (let* ((testfullname (conc (db:test-get-testname testdat)
+ (if (equal? "" (db:test-get-item-path testdat))
+ ""
+ (conc "/" (db:test-get-item-path testdat)))
+ )))
+ (print testfullname " " (db:test-get-comment testdat))))
+ tests)))
+ runs)
+ (set! *didsomething* #t)))
;;======================================================================
;; full run
;;======================================================================
@@ -1780,17 +1825,20 @@
(debug:print-info 0 *default-log-port* "Pattern supplied for target or runname with "
(length run-specs) " matches round. Running each in turn.")
(if (null? run-specs)
(debug:print 0 *default-log-port* "WARNING: No runs match target " target " and runname " runname))
(for-each (lambda (spec)
- (let* ((newcmdline (string-substitute
- (conc "target " target)
- (conc "target " (simple-run-target spec))
+ (let* ((precmd (if (args:get-arg "-precmd")(conc (args:get-arg "-precmd") " ") ""))
+ (newcmdline (conc
+ precmd
(string-substitute
- (conc "runname " runname)
- (conc "runname " (simple-run-runname spec))
- orig-cmdline))))
+ (conc "target " target)
+ (conc "target " (simple-run-target spec))
+ (string-substitute
+ (conc "runname " runname)
+ (conc "runname " (simple-run-runname spec))
+ orig-cmdline)))))
(debug:print 0 *default-log-port* "ORIG: " orig-cmdline)
(debug:print 0 *default-log-port* "NEW: " newcmdline)
(system newcmdline)))
run-specs))
(handle-run-requests target runname keys keyvals need-clean))))))
@@ -2444,10 +2492,17 @@
(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 "-syscheck")
+ (begin
+ (mutils:syscheck common:raw-get-remote-host-load
+ server:get-best-guess-address
+ read-config)
+ (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)))