Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -879,10 +879,18 @@ (list curmod fname) res))) '(0 "n/a") all-files))) +;; use bash to expand a glob. Does NOT handle paths with spaces! +;; +(define (common:bash-glob instr) + (string-split + (with-input-from-pipe + (conc "/bin/bash -c \"echo " instr "\"") + read-line))) + ;;====================================================================== ;; T A R G E T S , S T A T E , S T A T U S , ;; R U N N A M E A N D T E S T P A T T ;;====================================================================== Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -168,12 +168,15 @@ -config fname : override the megatest.config file with fname -append-config fname : append fname to the megatest.config file Utilities -env2file fname : write the environment to fname.csh and fname.sh - -envcap fname=context : save current variables labeled as context in file fname - -refdb2dat refdb : convert refdb to sexp or to format specified by -dumpmode + -envcap a : save current variables labeled as context 'a' in file envdat.db + -envdelta a-b : output enviroment delta from context a to context b to -o fname + set the output mode with -dumpmode csh, bash or ini + note: ini format will use calls to use curr and minimize path + -refdb2dat refdb : convert refdb to sexp or to format specified by s-dumpmode formats: perl, ruby, sqlite3, csv (for csv the -o param 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 Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -80,11 +80,11 @@ -repl : start a repl (useful for extending megatest) -load file.scm : load and run file.scm -debug N|N,M,O... : enable debug messages 0-N or N and M and O ... Utility - pgschema : emit postgresql schema; do \"mtutil db pgschema | psql -d mydb\" + db pgschema : emit postgresql schema; do \"mtutil db pgschema | psql -d mydb\" Examples: # Start a megatest run in the area \"mytests\" mtutil -area mytests -action run -target v1.63/aa3e -mode-patt MYPATT -tag-expr quick @@ -346,13 +346,24 @@ (lambda (sense) ;; these are the sense rules (let* ((key (car sense)) (val (cadr sense)) (keyparts (string-split key ":")) (contour (car keyparts)) - (ruletype (let ((res (cdr keyparts))) - (if (null? res) #f (cadr keyparts)))) - (valparts (string-split val)) ;; runname-rule params + (len-key (length keyparts)) + (ruletype (if (> len-key 1)(cadr keyparts) #f)) + (action (if (> len-key 2)(caddr keyparts) #f)) + (val-list (string-split-fields ";\\s*" val #:infix)) ;; (string-split val)) ;; runname-rule params + (val-alist (if val-list + (map (lambda (x) + (let ((f (string-split-fields "\\s*=\\s*" x #:infix))) + (case (length f) + ((0) `(,#f)) ;; null string case + ((1) `(,(string->symbol (car f)))) + ((2) `(,(string->symbol (car f)) . ,(cadr f))) + (else f)))) + val-list) + '())) (runname (make-runname "" "")) (runstarts (find-pkts pdb '(runstart) `((o . ,contour) (t . ,runkey)))) (rspkts (map (lambda (x) (alist-ref 'pkta x)) @@ -368,28 +379,30 @@ ) ;; look in runstarts for matching runs by target and contour ;; get the timestamp for when that run started and pass it ;; to the rule logic here where "ruletype" will be applied ;; if it comes back "changed" then proceed to register the runs - + (case (string->symbol ruletype) ((scheduled) - (if (not (eq? (length valparts) 6)) - (print "ERROR: bad sense spec \"" (string-intersperse sense " ") "\"") - (let* ((run-name (car valparts)) - (crontab (string-intersperse (cdr valparts))) + (if (not (alist-ref 'cron val-alist)) ;; gotta have cron spec + (print "ERROR: bad sense spec \"" (string-intersperse sense " ") "\" params: " val-alist) + (let* ((run-name (alist-ref 'run-name val-alist)) + (crontab (alist-ref 'cron val-alist)) + (action (alist-ref 'action val-alist)) (last-run (if (null? starttimes) ;; never run 0 (apply max (map cdr starttimes)))) (need-run (common:cron-event crontab #f last-run)) (runname (if need-run (conc "sched" (time->string (seconds->local-time (current-seconds)) "%M%H%d"))))) (print "last-run: " last-run " need-run: " need-run) (if need-run - (configf:section-var-set! torun contour runkey `(,(conc ruletype ":" (string-intersperse (cdr valparts) "-")) ,runname ,need-run)))))) + (configf:section-var-set! torun contour runkey `(,(conc ruletype ":" (string-intersperse (string-split (alist-ref 'cron val-alist)) "-")) + ,runname ,need-run ,action)))))) ((file file-or) ;; one or more files must be newer than the reference - (let* ((file-globs (cdr valparts)) - (youngestdat (common:get-youngest file-globs)) + (let* ((file-globs (alist-ref 'glob val-alist)) + (youngestdat (common:get-youngest (common:bash-glob file-globs))) (youngestmod (car youngestdat))) ;; (print "youngestmod: " youngestmod " starttimes: " starttimes) (if (null? starttimes) ;; this target has never been run (configf:section-var-set! torun contour runkey `("file:neverrun" ,runname)) (for-each @@ -399,11 +412,11 @@ (print "starttime younger than youngestmod: " starttime " Youngestmod: " youngestmod) (configf:section-var-set! torun contour runkey `(,(conc ruletype ":" (cadr youngestdat)) ,runname #f))))) starttimes)) )) ((file-and) ;; all files must be newer than the reference - (let* ((file-globs (cdr valparts)) + (let* ((file-globs (alist-ref 'glob val-alist)) (youngestdat (common:get-youngest file-globs)) (youngestmod (car youngestdat)) (success #t)) ;; any cases of not true, set flag to #f for AND ;; (print "youngestmod: " youngestmod " starttimes: " starttimes) (if (null? starttimes) ;; this target has never been run @@ -512,11 +525,11 @@ ;; (lambda (key) ;; (if (not (member key *legal-params*)) ;; (hash-table-delete! adjargs key))) ;; we need to delete any params intended for mtutil ;; (hash-table-keys adjargs)) (let-values (((uuid pkt) - (command-line->pkt *action* adjargs))) + (command-line->pkt *action* adjargs #f))) (write-pkt pktsdir uuid pkt)))) ((dispatch import rungen process) (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir"))) (mtconf (car mtconfdat)) (toppath (configf:lookup mtconf "dyndat" "toppath"))) Index: runconfigs.config ================================================================== --- runconfigs.config +++ runconfigs.config @@ -1,19 +1,29 @@ [v1.63/tip/dev] # file: files changes since last run trigger new run # script: script is called with unix seconds as last parameter (other parameters are preserved) # -# contour:sensetype runname params -quick:file auto *.scm -quick:script auto checkfossil.sh v1.63 +# contour:sensetype:action params data +quick:file:run run-name=auto;glob=*.scm +quick:file:clean run-name=auto; +quick:script:run run-name=auto;script=checkfossil.sh v1.63 # field allowed values # ----- -------------- # minute 0-59 # hour 0-23 # day of month 1-31 # month 1-12 (or names, see below) # day of week 0-7 (0 or 7 is Sun, or use names) -# every friday at midnight run all -all:scheduled auto 0 0 0 0 5 -quick:scheduled auto 47 * * * * +# actions: +# run - run a testsuite +# clean - clear out runs +# archive - archive runs + +quick:scheduled:run cron=47 * * * * ;run-name=auto +quick:scheduled:archive cron=15 20 * * * ;run-name=% ; + +[%/%/%] +# every friday at midnight clean "all" tests over 7d +all:scheduled:clean cron= 0 0 0 0 5;run-name=%;age=7d +