Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -27,11 +27,11 @@ process.scm runs.scm tasks.scm tests.scm genexample.scm \ http-transport.scm filedb.scm tdb.scm \ client.scm mt.scm \ ezsteps.scm lock-queue.scm sdb.scm \ rmt.scm api.scm subrun.scm \ - portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm + portlogger.scm archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm redo-logpro.scm # module source files MSRCFILES = ftail.scm # Eggs to install (straightforward ones) Index: ezsteps.scm ================================================================== --- ezsteps.scm +++ ezsteps.scm @@ -37,15 +37,19 @@ ;;(rmt:get-test-info-by-id run-id test-id) -> testdat -(define (ezsteps:run-from testdat start-step-name run-one) +(define (ezsteps:run-from testdat start-step-name-in run-one #!key (rerun-logpro-only #f) ) + ;; TODO: honor rerun-logpro-only + (if rerun-logpro-only + (BB> "someday soon...") (let* ((test-run-dir ;; (filedb:get-path *fdb* (db:test-get-rundir testdat)) ;; ) (testconfig (read-config (conc test-run-dir "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) (ezstepslst (hash-table-ref/default testconfig "ezsteps" '())) + (start-step-name (or start-step-name-in (if (null? ezsteplst) #f (car ezsteplst)))) (run-mutex (make-mutex)) (rollup-status 0) (exit-info (vector #t #t #t)) (test-id (db:test-get-id testdat)) (run-id (db:test-get-run_id testdat)) @@ -184,15 +188,15 @@ ;; for automated creation of the rollup html file this is a good place... (if (not (equal? item-path "")) (tests:summarize-items run-id test-id test-name #f)) ;; don't force - just update if no ))) (pop-directory) - rollup-status)) + rollup-status))) (define (ezsteps:spawn-run-from testdat start-step-name run-one) (thread-start! (make-thread (lambda () (ezsteps:run-from testdat start-step-name run-one)) (conc "ezstep run single step " start-step-name " run-one="run-one))) ) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -51,10 +51,11 @@ (declare (uses mt)) (declare (uses api)) (declare (uses tasks)) ;; only used for debugging. (declare (uses env)) (declare (uses diff-report)) +(declare (uses redo-logpro)) (declare (uses ftail)) (import ftail) (define *db* #f) ;; this is only for the repl, do not use in general!!!! @@ -115,10 +116,11 @@ -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 and then run the specified testpatt with -preclean -rerun-all : set all tests to NOT_STARTED,n/a and run with -preclean + -redo-logpro : do not rerun tests, but reapply logpro rules (ez-step flavor tests only; runs all tests unless -testpatt specified) -lock : lock run specified by target and runname -unlock : unlock run specified by target and runname -set-run-status status : sets status for run to status, requires -target and -runname -get-run-status : gets status for run specified by target and runname -run-wait : wait on run specified by target and runname @@ -291,10 +293,11 @@ "-set-toplog" "-runstep" "-logpro" "-m" "-rerun" + "-days" "-rename-run" "-to" ;; values and messages ":category" @@ -402,10 +405,11 @@ ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first "-runall" ;; run all tests, respects -testpatt, defaults to % "-run" ;; alias for -runall + "-redo-logpro" "-remove-runs" "-keep-records" ;; use with -remove-runs to remove only the run data "-rebuild-db" "-cleanup-db" "-rollup" @@ -571,11 +575,11 @@ (process:children #f)) (original-exit exit-code))))) ;; for some switches always print the command to stderr ;; -(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status") +(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status" "-redo-logpro") (debug:print 0 *default-log-port* (string-intersperse (argv) " "))) ;; some switches imply homehost. Exit here if not on homehost ;; (let ((homehost-required (list "-cleanup-db" "-server"))) @@ -1050,10 +1054,11 @@ (exit 1)) ;; put test parameters into convenient variables (begin ;; check for correct version, exit with message if not correct (common:exit-on-version-changed) + (BB> "before runs:operate-on") (runs:operate-on action target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") state: (common:args-get-state) @@ -1089,10 +1094,18 @@ (general-run-call "-set-state-status" "set state and status" (lambda (target runname keys keyvals) (operate-on 'set-state-status)))) + +(when (args:get-arg "-redo-logpro") + (BB> "redo-logpro request from command line detected") + (general-run-call + "-redo-logpro" + "rerun logpro in ezsteps" + (lambda (target runname keys keyvals) + (operate-on 'redo-logpro)))) (if (or (args:get-arg "-set-run-status") (args:get-arg "-get-run-status")) (general-run-call "-set-run-status" @@ -1241,10 +1254,12 @@ table-rows)))) (set! *didsomething* #t) (set! *time-to-exit* #t)) + + ;; NOTE: list-runs and list-db-targets operate on local db!!! ;; ADDED redo-logpro.scm Index: redo-logpro.scm ================================================================== --- /dev/null +++ redo-logpro.scm @@ -0,0 +1,36 @@ +;; Copyright 2006-2018, Matthew Welland. +;; +;; This file is part of Megatest. +;; +;; Megatest is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; Megatest is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with Megatest. If not, see . +;; + +(declare (unit redo-logpro)) +(declare (uses common)) +(declare (uses rmt)) +(declare (uses ezsteps)) +(include "common_records.scm") +(use matchable) +(use fmt) +(use ducttape-lib) +(define css "") + +(define (redo-logpro:redo-logpro run-id test-id testdat) + ;; TODO: populate testdat from testid, start-step-name (from first step) + ;; TODO: (ezsteps:run-from testdat start-step-name #f rerun-logpro-only: #t)) + + (BB> "redo-logpro:redo-logpro called with run-id="run-id" test-id="test-id" testdat="testdat) + (ezsteps:run-from testdat #f #f rerun-logpro-only: #t) + (print "redo-logpro Unimplemented") + #f) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -28,10 +28,11 @@ (declare (uses runconfig)) (declare (uses tests)) (declare (uses server)) (declare (uses mt)) (declare (uses archive)) +;;(declare (uses redo-logpro)) ;; (declare (uses filedb)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") @@ -2009,10 +2010,11 @@ ;; 'set-state-status ;; ;; NB// should pass in keys? ;; (define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(mode #f)(options '())) + (BB> "in runs:operate-on with action >"action"<") (common:clear-caches) ;; clear all caches (let* ((db #f) ;; (tdbdat (tasks:open-db)) (keys (rmt:get-keys)) (rundat (mt:get-runs-by-patt keys runnamepatt target)) @@ -2023,11 +2025,11 @@ (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f))) (rp-mutex (make-mutex)) (bup-mutex (make-mutex)) (keep-records (args:get-arg "-keep-records"))) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode". - (let* ((write-access-actions '(remove-runs set-state-status archive run-wait)) + (let* ((write-access-actions '(remove-runs set-state-status archive run-wait redo-logpro)) (dbfile (conc *toppath* "/megatest.db")) (readonly-mode (not (file-write-access? dbfile)))) (when (and readonly-mode (member action write-access-actions)) (debug:print-error 0 *default-log-port* "megatest.db is readonly. Cannot proceed with action ["action"] in which write-access isrequired .") @@ -2068,10 +2070,13 @@ ;; (if (equal? testpatt "%") (tasks:kill-runner target run-name testpatt) ;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt)) (debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))) + ((redo-logpro) + (BB> "redo-logpro operate-on hook 1") + (debug:print 1 *default-log-port* "Re-applying new logpro rules without rerun for tests for run: " runkey " " (db:get-value-by-header run header "runname"))) ((set-state-status) ;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10)) (debug:print 1 *default-log-port* "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname"))) ((print-run) (debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header) @@ -2132,10 +2137,11 @@ (test-state (db:test-get-state new-test-dat)) (test-fulln (db:test-get-fullname new-test-dat)) (uname (db:test-get-uname new-test-dat)) (toplevel-with-children (and (db:test-get-is-toplevel test) (> (rmt:test-toplevel-num-items run-id test-name) 0)))) + (BB> "arrived here 2") (case action ((remove-runs) ;; if the test is a toplevel-with-children issue an error and do not remove (cond (toplevel-with-children @@ -2202,10 +2208,11 @@ ) ; end case rem-status ) ; end let ); end cond has-subrun (else + (BB> "arrived 1") ;; BB - TODO - consider backgrounding to threads to delete tests (work below) (debug:print-info 0 *default-log-port* "test: " test-name " itest-state: " test-state) (if (member test-state (list "RUNNING" "LAUNCHED" "REMOTEHOSTSTART" "KILLREQ")) (begin (if (not (hash-table-ref/default test-retry-time test-fulln #f)) @@ -2230,10 +2237,17 @@ (begin (runs:remove-test-directory new-test-dat mode) ;; 'remove-all) (if (not (null? tal)) (loop (car tal)(cdr tal))))))) (rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id))) + ((redo-logpro) + (BB> "redo-logpro operate-on hook 2") + (redo-logpro:redo-logpro run-id test-id new-test-dat) + (debug:print-error 0 "redo-logpro unimplemented") + (if (not (null? tal)) + (loop (car tal)(cdr tal))) + ) ((set-state-status) (let* ((new-state (car state-status)) (new-status (cadr state-status)) (test-id (db:test-get-id test)) (test-run-dir (db:test-get-rundir new-test-dat))