Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -26,13 +26,13 @@ SHELL=/bin/bash PREFIX=$(PWD) CSCOPTS= INSTALL=install -SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm \ - server.scm configf.scm db.scm keys.scm \ - process.scm runs.scm tests.scm genexample.scm \ +SRCFILES = common.scm launch.scm runconfig.scm \ + server.scm configf.scm keys.scm \ + process.scm runs.scm genexample.scm \ tdb.scm mt.scm \ ezsteps.scm api.scm \ subrun.scm archive.scm env.scm \ diff-report.scm @@ -159,16 +159,14 @@ # cgisetup/models/pgdb.o \ # common.o \ # configf.o \ # db.o \ # env.o \ -# items.o \ # keys.o \ # launch.o \ # margs.o \ # mt.o \ -# ods.o \ # process.o \ # rmt.o \ # runconfig.o \ # runs.o \ # server.o \ @@ -229,11 +227,11 @@ # make $(MOIMPFILES) # touch mofiles-made megatest.o : megatest-fossil-hash.scm megatest-version.scm $(MOFILES) $(MOIMPFILES) -rmt.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm megatest-version.scm +common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm dcommon.scm ezsteps.scm index-tree.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tree.scm : common_records.scm megatest-version.scm common_records.scm : altdb.scm mofiles/dbfile.o : mofiles/commonmod.o @@ -536,13 +534,20 @@ # portlogger-example : portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o synchash.o tasks.o tdb.o tests.o tree.o # csc $(CSCOPTS) portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o sync-hash.o tasks.o tdb.o tests.o tree.o unitdeps.dot : *scm ./utils/plot-uses Makefile - ./utils/plot-uses todot commonmod.import,mtargs.import,mtargs,debugprint *.scm > unitdeps.dot + ./utils/plot-uses todot commonmod.import,mtargs.import,mtargs,debugprint $$(ls *.scm|grep -v import) > unitdeps.dot # ./utils/plot-uses todot commonmod,portlogger,stml2,debugprint,mtargs apimod.scm commonmod.scm configfmod.scm dbmod.scm megatestmod.scm mtmod.scm processmod.scm rmtmod.scm servermod.scm tcp-transportmod.scm > uses.dot ; dot uses.dot -Tpdf -o uses.pdf + +# apimod.scm commonmod.scm configfmod.scm dbmod.scm megatestmod.scm mtmod.scm processmod.scm rmtmod.scm servermod.scm tcp-transportmod.scm testsmod.scm + +uses.pdf : *scm utils/plot-uses Makefile + ./utils/plot-uses todot portlogger,stml2,debugprint,mtargs *mod.scm launch.scm > uses-in.dot + tred uses-in.dot > uses.dot + dot uses.dot -Tpdf -o uses.pdf unitdeps.pdf : unitdeps.dot dot unitdeps.dot -Tpdf -o unitdeps.pdf ./utils/plot-uses : utils/plot-uses.scm Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -17,11 +17,10 @@ ;; along with Megatest. If not, see . ;; ;;====================================================================== (declare (unit api)) -(declare (uses db)) (declare (uses apimod)) (declare (uses debugprint)) (declare (uses commonmod)) (declare (uses dbmod)) Index: archive.scm ================================================================== --- archive.scm +++ archive.scm @@ -17,11 +17,10 @@ ;; ;; strftime('%m/%d/%Y %H:%M:%S','now','localtime') (declare (unit archive)) -(declare (uses db)) (declare (uses debugprint)) (declare (uses mtargs)) (declare (uses common)) (declare (uses commonmod)) (declare (uses configfmod)) Index: archivemod.scm ================================================================== --- archivemod.scm +++ archivemod.scm @@ -236,17 +236,17 @@ (rsync-exe (or (configf:lookup *configdat* "archive" "rsync") "rsync")) (print-prefix "Running: ") (archive-info (archive:allocate-new-archive-block blockid-cache *toppath* tsname min-space target-patt run-patt "megatest-db")) (archive-dir (if archive-info (cdr archive-info) #f)) (archive-id (if archive-info (car archive-info) -1)) - (home-host #f) ;; FIXME! (server:choose-server *toppath* 'homehost)) + (home-host (get-host-name)) ;; FIXME! (server:choose-server *toppath* 'homehost)) (archive-time (seconds->std-time-str (current-seconds))) (archive-staging-db (conc *toppath* "/.db-snapshot/archive_" archive-time)) (tmp-db-path (conc (dbfile:make-tmpdir-name *toppath* "") "/megatest.db")) (dbfile (conc archive-staging-db "/megatest.db"))) (create-directory archive-staging-db #t) - (let-values (((pid-val exit-status exit-code) (run-n-wait rsync-exe params: (list "-v" (conc (car home-host) ":"tmp-db-path) archive-staging-db) print-cmd: print-prefix))) + (let-values (((pid-val exit-status exit-code) (run-n-wait rsync-exe params: (list "-v" (conc home-host ":"tmp-db-path) archive-staging-db) print-cmd: print-prefix))) (if (eq? exit-code 0) (case archiver ((bup) ;; Archive using bup (let* ((bup-init-params (list "-d" archive-dir "init")) (bup-index-params (list "-d" archive-dir "index" archive-staging-db)) Index: dashboard-context-menu.scm ================================================================== --- dashboard-context-menu.scm +++ dashboard-context-menu.scm @@ -25,19 +25,19 @@ (declare (unit dashboard-context-menu)) (declare (uses common)) (declare (uses commonmod)) (declare (uses configfmod)) -(declare (uses db)) (declare (uses gutils)) (declare (uses rmtmod)) (declare (uses ezsteps)) ;; (declare (uses sdb)) ;; (declare (uses filedb)) (declare (uses subrun)) (declare (uses testsmod)) (declare (uses subrunmod)) +(declare (uses megatestmod)) (use format fmt) (require-library iup) (import (prefix iup iup:)) @@ -53,11 +53,13 @@ (import commonmod configfmod rmtmod testsmod subrunmod - debugprint) + debugprint + megatestmod + ) (define (dboard:launch-testpanel run-id test-id) (let* ((dboardexe (common:find-local-megatest "dashboard")) (cmd (conc dboardexe " -test " run-id "," test-id Index: dashboard-guimonitor.scm ================================================================== --- dashboard-guimonitor.scm +++ dashboard-guimonitor.scm @@ -32,11 +32,10 @@ (import (prefix sqlite3 sqlite3:)) (declare (unit dashboard-guimonitor)) (declare (uses common)) (declare (uses keys)) -(declare (uses db)) (declare (uses commonmod)) (import commonmod) (include "common_records.scm") (include "db_records.scm") Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -34,11 +34,10 @@ (declare (uses tasksmod)) (declare (uses testsmod)) (declare (uses dcommon)) (declare (uses gutils)) -(declare (uses db)) (declare (uses ezsteps)) (declare (uses subrun)) (declare (uses runsmod)) (declare (uses subrunmod)) Index: dashboard-transport-mode.scm ================================================================== --- dashboard-transport-mode.scm +++ dashboard-transport-mode.scm @@ -15,8 +15,8 @@ ;; (rmt:transport-mode 'nfs) ;; uncomment this block to test with tcp and cachedb (dbfile:sync-method 'none) ;; original was causing crash on start. (dbfile:cache-method 'none) -(rmt:transport-mode 'nfs) - +(rmt:transport-mode 'tcp) +;; (rmt:transport-mode 'nfs) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -68,12 +68,11 @@ (declare (uses launchmod.import)) (declare (uses configf)) (declare (uses common)) (declare (uses keys)) -(declare (uses items)) -(declare (uses db)) + (declare (uses process)) (declare (uses launch)) (declare (uses runs)) (declare (uses dashboard-tests)) (declare (uses tree)) DELETED db.scm Index: db.scm ================================================================== --- db.scm +++ /dev/null @@ -1,70 +0,0 @@ -;;====================================================================== -;; Copyright 2006-2016, 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 . -;; -;;====================================================================== - -;;====================================================================== -;; Database access -;;====================================================================== - -;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc - -(declare (unit db)) -(declare (uses common)) -(declare (uses debugprint)) -(declare (uses dbmod)) -(declare (uses dbfile)) -(declare (uses keys)) -(declare (uses ods)) -(declare (uses mt)) -(declare (uses commonmod)) -(declare (uses configfmod)) -(declare (uses mtargs)) -(declare (uses rmtmod)) - -(import commonmod - configfmod - (prefix mtargs args:)) - -(use (srfi 18) - extras - ;; tcp - stack - (prefix sqlite3 sqlite3:) - srfi-1 - posix - regex - regex-case - srfi-69 - csv-xml - s11n - md5 - message-digest - (prefix base64 base64:) - format - dot-locking - z3 - typed-records - matchable - files) - -(import debugprint) -(import dbfile) -(import dbmod) -(import rmtmod) - Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -175,19 +175,19 @@ (define (tdb:step-stable-set-start! vec val)(vector-set! vec 1 val)) (define (tdb:step-stable-set-end! vec val)(vector-set! vec 2 val)) (define (tdb:step-stable-set-status! vec val)(vector-set! vec 3 val)) (define (tdb:step-stable-set-runtime! vec val)(vector-set! vec 4 val)) -;; The data structure for handing off requests via wire -(define (make-cdb:packet)(make-vector 6)) -(define (cdb:packet-get-client-sig vec) (vector-ref vec 0)) -(define (cdb:packet-get-qtype vec) (vector-ref vec 1)) -(define (cdb:packet-get-immediate vec) (vector-ref vec 2)) -(define (cdb:packet-get-query-sig vec) (vector-ref vec 3)) -(define (cdb:packet-get-params vec) (vector-ref vec 4)) -(define (cdb:packet-get-qtime vec) (vector-ref vec 5)) -(define (cdb:packet-set-client-sig! vec val)(vector-set! vec 0 val)) -(define (cdb:packet-set-qtype! vec val)(vector-set! vec 1 val)) -(define (cdb:packet-set-immediate! vec val)(vector-set! vec 2 val)) -(define (cdb:packet-set-query-sig! vec val)(vector-set! vec 3 val)) -(define (cdb:packet-set-params! vec val)(vector-set! vec 4 val)) -(define (cdb:packet-set-qtime! vec val)(vector-set! vec 5 val)) +;; ;; The data structure for handing off requests via wire +;; (define (make-cdb:packet)(make-vector 6)) +;; (define (cdb:packet-get-client-sig vec) (vector-ref vec 0)) +;; (define (cdb:packet-get-qtype vec) (vector-ref vec 1)) +;; (define (cdb:packet-get-immediate vec) (vector-ref vec 2)) +;; (define (cdb:packet-get-query-sig vec) (vector-ref vec 3)) +;; (define (cdb:packet-get-params vec) (vector-ref vec 4)) +;; (define (cdb:packet-get-qtime vec) (vector-ref vec 5)) +;; (define (cdb:packet-set-client-sig! vec val)(vector-set! vec 0 val)) +;; (define (cdb:packet-set-qtype! vec val)(vector-set! vec 1 val)) +;; (define (cdb:packet-set-immediate! vec val)(vector-set! vec 2 val)) +;; (define (cdb:packet-set-query-sig! vec val)(vector-set! vec 3 val)) +;; (define (cdb:packet-set-params! vec val)(vector-set! vec 4 val)) +;; (define (cdb:packet-set-qtime! vec val)(vector-set! vec 5 val)) Index: dbmod.scm ================================================================== --- dbmod.scm +++ dbmod.scm @@ -936,28 +936,10 @@ ;; ((http)(dbfile:with-db dbstruct run-id r/w proc params)) ;; ((tcp) (dbmod:with-db dbstruct run-id r/w proc params)) ;; ((nfs) (dbmod:with-db dbstruct run-id r/w proc params)) ;; (else (assert #f "FATAL: db:with-db called with non-existant transport mode")))) -;;====================================================================== -;; hash of hashs -;;====================================================================== - - -(define (db:hoh-set! dat key1 key2 val) - (let* ((subhash (hash-table-ref/default dat key1 #f))) - (if subhash - (hash-table-set! subhash key2 val) - (begin - (hash-table-set! dat key1 (make-hash-table)) - (db:hoh-set! dat key1 key2 val))))) - -(define (db:hoh-get dat key1 key2) - (let* ((subhash (hash-table-ref/default dat key1 #f))) - (and subhash - (hash-table-ref/default subhash key2 #f)))) - ;;====================================================================== ;; SQLITE3 HELPERS ;;====================================================================== (define (db:general-sqlite-error-dump exn stmt . params) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -19,11 +19,10 @@ ;;====================================================================== (declare (unit dcommon)) (declare (uses gutils)) -(declare (uses db)) (declare (uses dbmod)) (declare (uses commonmod)) (declare (uses configfmod)) (declare (uses rmtmod)) (declare (uses testsmod)) Index: docs/manual/debugging.txt ================================================================== --- docs/manual/debugging.txt +++ docs/manual/debugging.txt @@ -22,11 +22,11 @@ ~~~~~~~~~~~~~~~~~~ Test Design and Surfacing Errors ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Design your tests to surface errors. Ensure that all logs are +Design your tests to bring errors to the surface. Ensure all logs are processed by logpro (or a custom log processing tool) and can be reached by a mouse click or two from the test control panel. To illustrate, here is a set of scripts with nested calls where script1.sh calls script2.sh which calls script3.sh which finally calls the Cadence EDA tool virtuoso: Index: ezsteps.scm ================================================================== --- ezsteps.scm +++ ezsteps.scm @@ -18,16 +18,15 @@ ;; ;; strftime('%m/%d/%Y %H:%M:%S','now','localtime') (declare (unit ezsteps)) -(declare (uses db)) (declare (uses commonmod)) (declare (uses common)) (declare (uses configfmod)) (declare (uses debugprint)) -(declare (uses items)) + (declare (uses runconfig)) (declare (uses rmtmod)) (declare (uses mtargs)) (declare (uses tasksmod)) DELETED items.scm Index: items.scm ================================================================== --- items.scm +++ /dev/null @@ -1,34 +0,0 @@ - -;; Copyright 2006-2012, 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 . - - -;; (define itemdat '((ripeness "green ripe overripe") -;; (temperature "cool medium hot") -;; (season "summer winter fall spring"))) - -(declare (unit items)) -(declare (uses common)) -(declare (uses commonmod)) -(declare (uses configfmod)) -(declare (uses debugprint)) - -(import commonmod - configfmod - debugprint) - -(include "common_records.scm") Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -27,11 +27,10 @@ (declare (uses debugprint)) (declare (uses commonmod)) (declare (uses processmod)) (declare (uses configfmod)) (declare (uses configf)) -(declare (uses db)) (declare (uses rmtmod)) (declare (uses ezsteps)) ;; (declare (uses dbmod)) (declare (uses dbfile)) (declare (uses dbmod)) Index: launchmod.scm ================================================================== --- launchmod.scm +++ launchmod.scm @@ -1065,98 +1065,10 @@ ;; call end of eud of run detection for posthook - from merge, is it needed? ;; (launch:end-of-run-check run-id) all-ids) ))))) -;; set up needed environment variables given a run-id and optionally a target, itempath etc. -;; -(define (runs:set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)(intarget #f)(testname #f)(itempath #f)) - ;;(bb-check-path msg: "runs:set-megatest-env-vars entry") - (let* ((target (or intarget - (common:args-get-target) - (get-environment-variable "MT_TARGET"))) - (keys (if inkeys inkeys (rmt:get-keys))) - (keyvals (if inkeyvals inkeyvals (keys:target->keyval keys target))) - (vals (hash-table-ref/default *env-vars-by-run-id* run-id #f)) - (link-tree (common:get-linktree))) ;; (configf:lookup *configdat* "setup" "linktree"))) - (if testname (setenv "MT_TEST_NAME" testname)) - (if itempath (setenv "MT_ITEMPATH" itempath)) - - ;; get the info from the db and put it in the cache - (if link-tree - (setenv "MT_LINKTREE" link-tree) - (debug:print-error 0 *default-log-port* "linktree not set, should be set in megatest.config in [setup] section.")) - (if (not vals) - (let ((ht (make-hash-table))) - (hash-table-set! *env-vars-by-run-id* run-id ht) - (set! vals ht) - (for-each - (lambda (key) - (hash-table-set! vals (car key) (cadr key))) - keyvals))) - ;; from the cached data set the vars - - (hash-table-for-each - vals - (lambda (key val) - (debug:print 2 *default-log-port* "setenv " key " " val) - (safe-setenv key val))) - ;;(bb-check-path msg: "runs:set-megatest-env-vars block 1") - ;;(BB> "*env-vars-by-run-id*/runid("run-id" vals="(hash-table->alist vals)) - - (if (not (get-environment-variable "MT_TARGET"))(setenv "MT_TARGET" target)) - ;; we had a case where there was an exception generated by the hash-table-ref - ;; due to *configdat* being #f Adding a handle and exit - (let fatal-loop ((count 0)) - (handle-exceptions - exn - (let ((call-chain (get-call-chain)) - (msg ((condition-property-accessor 'exn 'message) exn))) - (if (< count 5) - (begin ;; this call is colliding, do some crude stuff to fix it. - (debug:print 0 *default-log-port* "ERROR: *configdat* was inaccessible! This should never happen. Retry #" count - ", exn=" exn) - (launch:setup force-reread: #t) - (fatal-loop (+ count 1))) - (begin - (debug:print 0 *default-log-port* "FATAL: *configdat* was inaccessible! This should never happen. Retried " count - " times. Message: " msg) - (debug:print 0 *default-log-port* "Call chain:") - (with-output-to-port *default-log-port* - (lambda () - (print "*configdat* is >>"*configdat*"<<") - (pp *configdat*) - (pp call-chain))) - - (exit 1)))) - ;;(bb-check-path msg: "runs:set-megatest-env-vars block 1.5") - (when (or (not *configdat*) (not (hash-table? *configdat*))) - (debug:print 0 *default-log-port* "WARNING: *configdat* was inaccessible! This should never happen. Brute force reread.") - ;;(BB> "ERROR: *configdat* was inaccessible! This should never happen. Brute force reread.") - (thread-sleep! 2) ;; assuming nfs lag. - (launch:setup force-reread: #t)) - (alist->env-vars (hash-table-ref/default *configdat* "env-override" '())))) ;;;; environment is tainted HERE in this let block. - ;;(bb-check-path msg: "runs:set-megatest-env-vars block 2") - ;; Lets use this as an opportunity to put MT_RUNNAME in the environment - (let ((runname (if inrunname inrunname (rmt:get-run-name-from-id run-id)))) - (if runname - (setenv "MT_RUNNAME" runname) - (debug:print-error 0 *default-log-port* "no value for runname for id " run-id))) - (setenv "MT_RUN_AREA_HOME" *toppath*) - ;; if a testname and itempath are available set the remaining appropriate variables - (if testname (setenv "MT_TEST_NAME" testname)) - (if itempath (setenv "MT_ITEMPATH" itempath)) - ;;(bb-check-path msg: "runs:set-megatest-env-vars block 3") - (if (and testname link-tree) - (setenv "MT_TEST_RUN_DIR" (conc (getenv "MT_LINKTREE") "/" - (getenv "MT_TARGET") "/" - (getenv "MT_RUNNAME") "/" - (getenv "MT_TEST_NAME") - (if (and itempath - (not (equal? itempath ""))) - (conc "/" itempath) - "")))))) ;; TODO: deprecate me in favor of ezsteps.scm ;; (define (ezsteps:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat) (let* ((stepname (car ezstep)) ;; do stuff to run the step Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -18,6 +18,6 @@ ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. ;; (declare (unit megatest-version)) -(define megatest-version 1.8028) +(define megatest-version 1.9001) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -75,25 +75,21 @@ (declare (uses cpumod.import)) (declare (uses runsmod)) (declare (uses ezstepsmod)) (declare (uses launchmod)) - (declare (uses tdb)) (declare (uses mt)) (declare (uses api)) (declare (uses env)) (declare (uses diff-report)) -(declare (uses db)) (declare (uses runs)) (declare (uses launch)) (declare (uses server)) -(declare (uses tests)) (declare (uses genexample)) ;; (declare (uses daemon)) -(declare (uses db)) ;; (declare (uses dcommon)) ;; (declare (uses debugprint)) ;; (declare (uses debugprint.import)) Index: monitor.scm ================================================================== --- monitor.scm +++ monitor.scm @@ -19,13 +19,12 @@ (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking) (import (prefix sqlite3 sqlite3:)) (declare (unit runs)) -(declare (uses db)) (declare (uses common)) -(declare (uses items)) + (declare (uses runconfig)) (declare (uses commonmod)) (import commonmod) (include "common_records.scm") Index: mt.scm ================================================================== --- mt.scm +++ mt.scm @@ -22,17 +22,15 @@ (import (prefix sqlite3 sqlite3:)) (declare (unit mt)) (declare (uses debugprint)) -(declare (uses db)) (declare (uses common)) (declare (uses commonmod)) (declare (uses configfmod)) -(declare (uses items)) + (declare (uses runconfig)) -(declare (uses tests)) (declare (uses server)) (declare (uses runs)) (declare (uses rmtmod)) (declare (uses megatestmod)) DELETED ods.scm Index: ods.scm ================================================================== --- ods.scm +++ /dev/null @@ -1,24 +0,0 @@ -;; Copyright 2011, 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 . -;; - -(use csv-xml regex) -(declare (unit ods)) -(declare (uses common)) -(declare (uses commonmod)) -(import commonmod) - DELETED rmtdb.scm Index: rmtdb.scm ================================================================== --- rmtdb.scm +++ /dev/null @@ -1,20 +0,0 @@ -;;====================================================================== -;; Copyright 2006-2013, 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 . - -;;====================================================================== - Index: rmtmod.scm ================================================================== --- rmtmod.scm +++ rmtmod.scm @@ -249,12 +249,17 @@ (define (rmt:send-receive cmd run-id params #!key (attemptnum 1)(ttdat #f)) (assert (or (not run-id) (number? run-id)) "FATAL: run-id is required to be a number or #f") (assert *toppath* "FATAL: rmt:send-receive called with *toppath* not set.") (let* ((areapath *toppath*) ;; TODO - resolve from dbstruct to be compatible with multiple areas (readonly-mode (rmtmod:calc-ro-mode ttdat *toppath*)) - (testsuite (common:get-testsuite-name))) - (case (rmt:transport-mode) + (testsuite (common:get-testsuite-name)) + (tmode (if (rmt:on-homehost?) ;; use tmode instead of rmt:transport-mode to access /tmp db (to be implemented) + (if (> (random 100) 80) ;; 20% of time + 'tcp + 'tmp) ;; this mode needs to be implemented + (rmt:transport-mode)))) + (case (rmt:transport-mode) ;; replace with tmode ((tcp) (let* ((start-time (current-seconds)) ;; snapshot time so all use cases get same value (attemptnum (+ 1 attemptnum)) (mtexe (common:find-local-megatest)) (dbfname (conc (dbfile:run-id->dbnum run-id)".db")) @@ -912,23 +917,11 @@ (define (rmt:test-get-archive-block-info archive-block-id) (rmt:send-receive 'test-get-archive-block-info #f (list archive-block-id))) (define (rmtmod:calc-ro-mode runremote *toppath*) (case (rmt:transport-mode) - ((http) - (if (and runremote - (remote-ro-mode-checked runremote)) - (remote-ro-mode runremote) - (let* ((mtcfgfile (conc *toppath* "/megatest.config")) - (ro-mode (not (file-write-access? mtcfgfile)))) ;; TODO: use dbstruct or runremote to figure this out in future - (if runremote - (begin - (remote-ro-mode-set! runremote ro-mode) - (remote-ro-mode-checked-set! runremote #t) - ro-mode) - ro-mode)))) - ((tcp) + ((tcp nfs) (if (and runremote (tt-ro-mode-checked runremote)) (tt-ro-mode runremote) (let* ((mtcfgfile (conc *toppath* "/megatest.config")) (ro-mode (not (file-write-access? mtcfgfile)))) ;; TODO: use dbstruct or runremote to figure this out in future @@ -935,11 +928,13 @@ (if runremote (begin (tt-ro-mode-set! runremote ro-mode) (tt-ro-mode-checked-set! runremote #t) ro-mode) - ro-mode)))))) + ro-mode)))) + (else + (assert #f "FATAL: invalid rmt:transport-mode")))) ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== @@ -1014,19 +1009,10 @@ ;; Move me elsewhere ... ;; RADT => Why do we meed the version check here, this is called only if version misma ;; (define (common:cleanup-db dbstruct #!key (full #f)) (case (rmt:transport-mode) - ((http) - (apply db:multi-db-sync - dbstruct - 'schema - 'killservers - 'adj-target - 'new2old - '(dejunk) - )) ((tcp nfs) (apply db:multi-db-sync dbstruct 'schema 'killservers Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -29,15 +29,13 @@ (declare (uses megatestmod)) (declare (uses mtmod)) (declare (uses tasksmod)) (declare (uses servermod)) -(declare (uses db)) (declare (uses common)) -(declare (uses items)) + (declare (uses runconfig)) -(declare (uses tests)) (declare (uses server)) (declare (uses mt)) (declare (uses archive)) (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -17,11 +17,10 @@ ;; (declare (unit server)) (declare (uses common)) -(declare (uses db)) (declare (uses debugprint)) (declare (uses commonmod)) (declare (uses configfmod)) (declare (uses rmtmod)) (declare (uses launch)) Index: stml2/stml2.scm ================================================================== --- stml2/stml2.scm +++ stml2/stml2.scm @@ -1150,11 +1150,11 @@ (if (and (not (null? alldats)) (not (null? (car alldats))) (not (null? (caar alldats)))) (formdat:load formdat (s:process-cgi-input (caaar alldats))))) ;; munged)) ;; (format debugp "formdat : name: ~A content: ~A\n" name content) - (if debugp (close-output-port debugp)) + ;; (if debugp (close-output-port debugp)) ;; (sdat-formdat-set! s:session formdat) formdat)))) #| (define inp (open-input-file "tests/example.post.in")) Index: subrun.scm ================================================================== --- subrun.scm +++ subrun.scm @@ -24,11 +24,10 @@ (declare (uses commonmod)) (declare (uses configfmod)) (declare (uses tasksmod)) (declare (uses mt)) -(declare (uses db)) (declare (uses common)) (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) posix-extras directory-utils pathname-expand typed-records format call-with-environment-variables) Index: tdb.scm ================================================================== --- tdb.scm +++ tdb.scm @@ -24,13 +24,11 @@ (declare (unit tdb)) (declare (uses debugprint)) (declare (uses common)) (declare (uses keys)) -(declare (uses ods)) (declare (uses mt)) -(declare (uses db)) (declare (uses commonmod)) (declare (uses mtargs)) (declare (uses rmtmod)) (require-extension (srfi 18) extras tcp) DELETED tests.scm Index: tests.scm ================================================================== --- tests.scm +++ /dev/null @@ -1,52 +0,0 @@ -;;====================================================================== -;; Copyright 2006-2013, 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 . -;; -;;====================================================================== - -;;====================================================================== -;; Tests -;;====================================================================== - -(declare (unit tests)) -(declare (uses db)) -(declare (uses tdb)) -(declare (uses debugprint)) -(declare (uses common)) -(declare (uses commonmod)) -(declare (uses configf)) -(declare (uses configfmod)) -(declare (uses items)) -(declare (uses runconfig)) -(declare (uses server)) -(declare (uses mtargs)) -(declare (uses rmtmod)) -(declare (uses megatestmod)) -(declare (uses tasksmod)) - -(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking directory-utils) -(import (prefix sqlite3 sqlite3:)) -(import commonmod - configfmod - (prefix mtargs args:) - debugprint - rmtmod - megatestmod - tasksmod - ) -(require-library stml) - Index: tree.scm ================================================================== --- tree.scm +++ tree.scm @@ -21,11 +21,10 @@ (declare (unit tree)) (declare (uses mtargs)) (declare (uses debugprint)) (declare (uses launch)) (declare (uses gutils)) -(declare (uses db)) (declare (uses server)) (declare (uses dcommon)) (use format) (require-library iup)