Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -150,26 +150,27 @@ # $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm # csc utils/revtagfsl.scm -o $(PREFIX)/bin/revtagfsl # Special dependencies for the includes tests.o db.o launch.o runs.o dashboard-tests.o dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o monitor.o dashboard.o \ -archive.o megatest.o : db_records.scm +archive.o megatest.o : db_records.scm migrate-fix.scm tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o : run_records.scm db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm tests.o tasks.o dashboard-tasks.o : task_records.scm runs.o : test_records.scm megatest.o : megatest-fossil-hash.scm rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.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 common_records.scm : altdb.scm vg.o dashboard.o : vg_records.scm -dcommon.o : run_records.scm +dcommon.o : run_records.scm migrate-fix.scm # Temporary while transitioning to new routine # runs.o : run-tests-queue-classic.scm run-tests-queue-new.scm # for the modularized stuff +mofiles/dbmod.o : mofiles/commonmod.o mofiles/commonmod.o : mofiles/configfmod.o -mofiles/rmtmod.o : mofiles/dbmod.o mofiles/commonmod.o +mofiles/rmtmod.o : mofiles/dbmod.o mofiles/commonmod.o # $(MOFILES) : mofiles/commonmod.o megatest-fossil-hash.scm : $(SRCFILES) megatest.scm *_records.scm echo "(define megatest-fossil-hash \"$(MTESTHASH)\")" > megatest-fossil-hash.new @@ -331,10 +332,11 @@ fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL) clean : rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut tcmt ftail.import.scm readline-fix.scm serialize-env dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o rm -rf share + rm -f *.import.scm #====================================================================== # Make the records files #====================================================================== Index: client.scm ================================================================== --- client.scm +++ client.scm @@ -73,11 +73,11 @@ ;; 2. We are a run tests, list runs or other interactive process and we must figure out ;; *transport-type* and *runremote* from the monitor.db ;; ;; client:setup ;; -;; lookup_server, need to remove *runremote* stuff +;; lookup_server, need to remove *runremote* stuff -> replace with *alldat* for now ;; (define (client:setup-http runremote areapath #!key (remaining-tries 100) (failed-connects 0)) ;; (area-dat #f)) (debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries) (server:start-and-wait areapath) Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -2005,11 +2005,11 @@ (< (cadr a)(cadr b)))))) ;; check available space in dbdir, exit if insufficient ;; (define (common:check-db-dir-and-exit-if-insufficient) - (let* ((spacedat (car (common:check-db-dir-space))) ;; look only at worst for now + (let* ((spacedat (car (common:check-db-dir-space *alldat*))) ;; look only at worst for now (is-ok (car spacedat)) (dbspace (cadr spacedat)) (required (caddr spacedat)) (dbdir (cadddr spacedat))) (if (not is-ok) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -46,13 +46,17 @@ (declare (uses vg)) (declare (uses subrun)) ;; (declare (uses dashboard-main)) (declare (uses megatest-version)) (declare (uses mt)) + (declare (uses commonmod)) (import commonmod) - +(declare (uses rmtmod)) +(import rmtmod) +(declare (uses dbmod)) +(import dbmod) (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") (include "task_records.scm") @@ -103,10 +107,16 @@ "-repl" "-rh5.11" ;; fix to allow running on rh5.11 ) args:arg-hash 0)) + +;; (set! *functions* dbmod#*functions*) +;; (set! apimod#*functions* dbmod#*functions*) +;; (set! configfmod#*functions* dbmod#*functions*) + +(include "migrate-fix.scm") ;; check for MT_* environment variables and exit if found (if (not (args:get-arg "-test")) (begin (display "Checking for MT_ vars: ") Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -501,14 +501,10 @@ (work-area (assoc/default 'work-area cmdinfo)) ;; work-area is the test run area (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (ezsteps (assoc/default 'ezsteps cmdinfo)) (subrun (assoc/default 'subrun cmdinfo)) - ;; (runremote (assoc/default 'runremote cmdinfo)) - ;; (transport (assoc/default 'transport cmdinfo)) ;; not used - ;; (serverinf (assoc/default 'serverinf cmdinfo)) - ;; (port (assoc/default 'port cmdinfo)) (serverurl (assoc/default 'serverurl cmdinfo)) (homehost (assoc/default 'homehost cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) (test-id (assoc/default 'test-id cmdinfo)) (target (assoc/default 'target cmdinfo)) @@ -1626,12 +1622,12 @@ ;; (list 'serverinf *server-info*) (list 'homehost (let* ((hhdat (common:get-homehost))) (if hhdat (car hhdat) #f))) - (list 'serverurl (if *runremote* - (remote-server-url *runremote*) + (list 'serverurl (if *alldat* + (alldat-server-url *alldat*) #f)) ;; (list 'areaname (common:get-area-name *alldat*)) (list 'toppath *toppath*) (list 'work-area work-area) (list 'test-name test-name) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -523,33 +523,15 @@ (exn () (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath) (define *didsomething* #t) (exit 1)))) -;; this is a good place to populate the *functions* hash with -;; functions needed during the transition to modules -;; -;; NOTE: the definition in dbmod seems to "win" - make it available everywhere -;; -(set! *functions* dbmod#*functions*) -(set! apimod#*functions* dbmod#*functions*) -(set! configfmod#*functions* dbmod#*functions*) - -(set-fn 'client:setup client:setup) -(set-fn 'db:setup db:setup) -(set-fn 'server:expiration-timeout server:expiration-timeout) -(set-fn 'common:get-homehost common:get-homehost) -(set-fn 'server:check-if-running server:check-if-running) -(set-fn 'api:execute-requests api:execute-requests) -(set-fn 'http-transport:close-connections http-transport:close-connections ) -(set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive) -(set-fn 'server:kind-run server:kind-run) -(set-fn 'server:start-and-wait server:start-and-wait) -(set-fn 'server:check-if-running server:check-if-running) -(set-fn 'server:ping server:ping ) -(set-fn 'common:force-server? common:force-server? ) - +;; (set! *functions* dbmod#*functions*) +;; (set! apimod#*functions* dbmod#*functions*) +;; (set! configfmod#*functions* dbmod#*functions*) + +(include "migrate-fix.scm") ;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not ;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation ;; where (launch:setup) returns #f? ;; ADDED migrate-fix.scm Index: migrate-fix.scm ================================================================== --- /dev/null +++ migrate-fix.scm @@ -0,0 +1,18 @@ +;; this is a good place to populate the *functions* hash with +;; functions needed during the transition to modules +;; +;; NOTE: the definition in dbmod seems to "win" - make it available everywhere +;; +(set-fn 'client:setup client:setup) +(set-fn 'db:setup db:setup) +(set-fn 'server:expiration-timeout server:expiration-timeout) +(set-fn 'common:get-homehost common:get-homehost) +(set-fn 'server:check-if-running server:check-if-running) +(set-fn 'api:execute-requests api:execute-requests) +(set-fn 'http-transport:close-connections http-transport:close-connections ) +(set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive) +(set-fn 'server:kind-run server:kind-run) +(set-fn 'server:start-and-wait server:start-and-wait) +(set-fn 'server:check-if-running server:check-if-running) +(set-fn 'server:ping server:ping ) +(set-fn 'common:force-server? common:force-server? ) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -1468,19 +1468,10 @@ itemmaps: itemmaps ;; prereqs-not-met: prereqs-not-met ))) (runs:dat-regfull-set! runsdat regfull) - ;; -- removed BB 17ww28 - no longer needed. - ;; every 15 minutes verify the server is there for this run - ;; (if (and (common:low-noise-print 240 "try start server" run-id) - ;; (not (or (and *runremote* - ;; (remote-server-url *runremote*) - ;; (server:ping (remote-server-url *runremote*))) - ;; (server:check-if-running *toppath*)))) - ;; (server:kind-run *toppath*)) - (if (> num-running 0) (set! last-time-some-running (current-seconds))) (if (> (current-seconds)(+ last-time-some-running (or (configf:lookup *configdat* "setup" "give-up-waiting") 36000))) (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1))) Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -1771,11 +1771,11 @@ (itemdat (tests:testqueue-get-itemdat test-record)) (item-path (tests:testqueue-get-item_path test-record)) (waitons (tests:testqueue-get-waitons test-record)) (keep-test #t) (test-id (rmt:get-test-id run-id test-name item-path)) - (tdat (rmt:get-testinfo-state-status run-id test-id))) ;; (cdb:get-test-info-by-id *runremote* test-id))) + (tdat (rmt:get-testinfo-state-status run-id test-id))) (if tdat (begin ;; Look at the test state and status (if (or (and (member (db:test-get-status tdat) '("PASS" "WARN" "WAIVED" "CHECK" "SKIP")) @@ -1788,11 +1788,11 @@ ;; from the runnable list (if keep-test (for-each (lambda (waiton) ;; for now we are waiting only on the parent test (let* ((parent-test-id (rmt:get-test-id run-id waiton "")) - (wtdat (rmt:get-testinfo-state-status run-id test-id))) ;; (cdb:get-test-info-by-id *runremote* test-id))) + (wtdat (rmt:get-testinfo-state-status run-id test-id))) (if (or (and (equal? (db:test-get-state wtdat) "COMPLETED") (member (db:test-get-status wtdat) '("FAIL" "ABORT"))) (member (db:test-get-status wtdat) '("KILLED")) (member (db:test-get-state wtdat) '("INCOMPETE"))) ;; (if (or (member (db:test-get-status wtdat)