Index: datashare-testing/.sd.config ================================================================== --- datashare-testing/.sd.config +++ datashare-testing/.sd.config @@ -8,11 +8,11 @@ [settings] storage /tmp/#{getenv USER}/datashare/disk1 \ /tmp/#{getenv USER}/datashare/disk2 -basepath #{getenv BASEPATH} +basepath #{scheme (or (getenv "BASEPATH") "/tmp/#{getenv USER}")} [areas] synthesis asic/synthesis verilog asic/verilog customlibs custom/oalibs Index: datashare.scm ================================================================== --- datashare.scm +++ datashare.scm @@ -655,11 +655,11 @@ )))) (define (datashare:gui configdat) (iup:show (iup:dialog - #:title (conc "DataShare dashboard " (current-user-name) ":" (current-directory)) + #:title (conc "DataShare dashboard " (current-user-name) ":" (current-directory)) #:menu (datashare:main-menu) (let* ((tabs (iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (set! *datashare:current-tab-number* curr)) (datashare:publish-view configdat) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2242,14 +2242,16 @@ ;; set tests with state currstate and status currstatus to newstate and newstatus ;; use currstate = #f and or currstatus = #f to apply to any state or status respectively ;; WARNING: SQL injection risk. NB// See new but not yet used "faster" version below ;; - ;; AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));"))) - ;;(debug:print 0 "QRY: " qry) - ;; (db:delay-if-busy) - +;; AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));"))) +;; (debug:print 0 "QRY: " qry) +;; (db:delay-if-busy) +;; +;; NB// This call only operates on toplevel tests. Consider replacing it with more general call +;; (define (db:set-tests-state-status dbstruct run-id testnames currstate currstatus newstate newstatus) (for-each (lambda (testname) (let ((qry (conc "UPDATE tests SET state=?,status=? WHERE " (if currstate (conc "state='" currstate "' AND ") "") (if currstatus (conc "status='" currstatus "' AND ") "") @@ -2257,12 +2259,13 @@ (db:with-db dbstruct run-id #t (lambda (db) - (sqlite3:execute db qry newstate newstatus run-id testname) - (mt:process-triggers run-id test-id newstate newstatus) + (let ((test-id (db:get-test-id dbstruct run-id testname ""))) + (sqlite3:execute db qry newstate newstatus run-id testname) + (if test-id (mt:process-triggers run-id test-id newstate newstatus))) )))) testnames)) ;; speed up for common cases with a little logic ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id @@ -3263,36 +3266,59 @@ ;; A routine to map itempaths using a itemmap (define (db:compare-itempaths patha pathb itemmap) (debug:print-info 6 "ITEMMAP is " itemmap) (if itemmap - (let* ((mapparts (string-split itemmap)) - (pattern (car mapparts)) - (replacement (if (> (length mapparts) 1) (cadr mapparts) ""))) - (if replacement - (equal? (string-substitute pattern replacement patha) - (string-substitute pattern replacement pathb)) - (equal? (string-substitute pattern "" patha) - (string-substitute pattern "" pathb)))) + (let ((path-b-mapped (db:convert-test-itempath pathb itemmap))) + (debug:print-info 6 "ITEMMAP is " itemmap ", path: " pathb ", mapped path: " path-b-mapped) + (equal? patha pathb)) (equal? patha pathb))) +;; (let* ((mapparts (string-split itemmap)) +;; (pattern (car mapparts)) +;; (replacement (if (> (length mapparts) 1) (cadr mapparts) ""))) +;; (if replacement +;; (equal? (string-substitute pattern replacement patha) +;; (string-substitute pattern replacement pathb)) +;; (equal? (string-substitute pattern "" patha) +;; (string-substitute pattern "" pathb)))) + ;; A routine to convert test/itempath using a itemmap (define (db:convert-test-itempath path-in itemmap) (debug:print-info 6 "ITEMMAP is " itemmap) - (let* ((mapparts (string-split itemmap)) - (pattern (car mapparts)) - (replacement (if (> (length mapparts) 1) (cadr mapparts) "")) - (path-parts (string-split path-in "/")) - (test-name (car path-parts)) - (item-path (string-intersperse (cdr path-parts) "/"))) + (let* ((path-parts (string-split path-in "/")) + (test-name (if (null? path-parts) "" (car path-parts))) + (item-path (string-intersperse (if (null? path-parts) '() (cdr path-parts)) "/"))) (conc test-name "/" - (if replacement - (string-substitute pattern replacement item-path) - (string-substitute pattern "" path-in))))) + (db:multi-pattern-apply item-path itemmap)))) + +;; patterns are: +;; "rx1" "replacement1"\n +;; "rx2" "replacement2" +;; etc. +;; +(define (db:multi-pattern-apply item-path itemmap) + (let ((all-patts (string-split itemmap "\n"))) + (if (null? all-patts) + item-path + (let loop ((hed (car all-patts)) + (tal (cdr all-patts)) + (res item-path)) + (let* ((parts (string-split hed)) + (patt (car parts)) + (repl (if (> (length parts) 1)(cadr parts) "")) + (newr (if (and patt repl) + (string-substitute patt repl res) + (begin + (debug:print 0 "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl) + res)))) + (if (null? tal) + newr + (loop (car tal)(cdr tal) newr))))))) ;; the new prereqs calculation, looks also at itempath if specified -;; all prereqs must be met: +;; all prereqs must be met ;; if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met ;; if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met ;; ;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED) ;; mode 'toplevel means that tests must be COMPLETED only Index: docs/manual/megatest_manual.html ================================================================== --- docs/manual/megatest_manual.html +++ docs/manual/megatest_manual.html @@ -1135,10 +1135,20 @@
test/itempath ⇒ host-type
runfirst/sum% remote
+
+

Miscellaneous Setup Items

+

Attempt to rerun tests in "STUCK/DEAD", "n/a", "ZERO_ITEMS" states.

+
+
In megatest.config
+
+
[setup]
+reruns 5
+
+

The testconfig File

@@ -1278,10 +1288,16 @@
Skip if this test has been run in the past fifteen minutes and 15 seconds.
[skip]
 rundelay 15m 15s
+ +
+

Disks

+

A disks section in testconfig will override the disks section in +megatest.config. This can be used to allocate disks on a per-test or per item +basis.

Controlled waiver propagation

If test is FAIL and previous test in run with same MT_TARGET is WAIVED then apply the following rules from the testconfig: If a waiver check is specified in the testconfig apply the check and if it passes then set this FAIL to WAIVED

@@ -1562,10 +1578,10 @@
Index: docs/manual/reference.txt ================================================================== --- docs/manual/reference.txt +++ docs/manual/reference.txt @@ -46,10 +46,21 @@ ^^^^^^^^^ .test/itempath => host-type ------------ runfirst/sum% remote ------------ + +Miscellaneous Setup Items +^^^^^^^^^^^^^^^^^^^^^^^^^ + +Attempt to rerun tests in "STUCK/DEAD", "n/a", "ZERO_ITEMS" states. + +.In megatest.config +------------------ +[setup] +reruns 5 +------------------ The testconfig File ------------------- Setup section Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -788,11 +788,12 @@ (let ((data (full-runconfigs-read))) ;; keep this one local (cond ((and (args:get-arg "-section") (args:get-arg "-var")) - (let ((val (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")))) + (let ((val (or (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")) + (configf:lookup data "default" (args:get-arg "-var"))))) (if val (print val)))) ((not (args:get-arg "-dumpmode")) (pp (hash-table->alist data))) ((string=? (args:get-arg "-dumpmode") "json") (json-write data)) DELETED readline-fix.scm Index: readline-fix.scm ================================================================== --- readline-fix.scm +++ /dev/null @@ -1,2 +0,0 @@ -(use-legacy-bindings) -(define (toplevel-command . a) #f) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -224,12 +224,19 @@ (all-tests-registry #f) ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names (all-test-names #f) ;; (hash-table-keys all-tests-registry)) (test-names #f) ;; (tests:filter-test-names all-test-names test-patts)) (required-tests #f) ;; Put fully qualified test/testpath names in this list to be done (task-key (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id))) - (tdbdat (tasks:open-db))) + (tdbdat (tasks:open-db)) + (config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns"))) + (if x (string->number x) #f)))) + ;; override the number of reruns from the configs + (if (and config-reruns + (> run-count config-reruns)) + (set! run-count config-reruns)) + (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10)) (let ((sighand (lambda (signum) ;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting (if (eq? signum signal/stop) @@ -482,11 +489,11 @@ (thread-start! th2) (thread-join! th1) (set! keep-going #f) (thread-join! th2) ;; if run-count > 0 call, set -preclean and -rerun STUCK/DEAD - (if (> run-count 0) + (if (> run-count 0) ;; handle reruns (begin (if (not (hash-table-ref/default flags "-preclean" #f)) (hash-table-set! flags "-preclean" #t)) (if (not (hash-table-ref/default flags "-rerun" #f)) (hash-table-set! flags "-rerun" "STUCK/DEAD,n/a,ZERO_ITEMS")) Index: tests/fdktestqa/testqa/configs/megatest.def.config ================================================================== --- tests/fdktestqa/testqa/configs/megatest.def.config +++ tests/fdktestqa/testqa/configs/megatest.def.config @@ -2,7 +2,7 @@ [env-override] EXAMPLE_VAR example value # As you run more tests you may need to add additional disks, the names are arbitrary but must be unique [disks] -disk0 #{scheme (nice-path "#{getenv MT_RUN_AREA_HOME}/../simpleruns")} +disk0 #{scheme (create-directory (nice-path "#{getenv MT_RUN_AREA_HOME}/../simpleruns") #t)} Index: tests/fullrun/megatest.config ================================================================== --- tests/fullrun/megatest.config +++ tests/fullrun/megatest.config @@ -145,11 +145,11 @@ # RUNDEAD [system exit 56] [server] # force use of server always -required yes +# required yes # Use http instead of direct filesystem access transport http # transport fs # transport nmsg @@ -161,20 +161,19 @@ port 9080 # This server will keep running this number of hours after last access. # Three minutes is 0.05 hours # timeout 0.025 -timeout 0.061 +timeout 0.01 # faststart; unless no, start server but proceed with writes until server started -faststart no -# faststart yes +# faststart no +faststart yes # Start server when average query takes longer than this # server-query-threshold 55500 server-query-threshold 1000 -timeout 0.01 # daemonize yes # hostname #{scheme (get-host-name)} ## disks are: @@ -286,13 +285,13 @@ [jobtools] flexi-launcher yes [host-types] -general bsub +general nbfake alt #{get jobtools launcher} local nbfake remote #{get jobtools launcher} [launchers] runfirst/sum% remote % general Index: tests/unittests/runs.scm ================================================================== --- tests/unittests/runs.scm +++ tests/unittests/runs.scm @@ -320,10 +320,16 @@ (test "server stop" #f (let ((hostname (car *runremote*)) (port (cadr *runremote*))) (tasks:kill-server #t hostname port server-pid 'http) (open-run-close tasks:get-best-server tasks:open-db))) +;;====================================================================== +;; M O R E R E M O T E C A L L S +;;====================================================================== + +(test #f #f (rmt:set-tests-state-status 1 '("runfirst") "RUNNING" "WARN" "COMPLETED" "FAIL")) + ;; (cdb:kill-server *runremote*) ;; (thread-join! th1 th2 th3) ;; ADD ME!!!! (db:get-prereqs-not-met *db* 1 '("runfirst") "" mode: 'normal)