Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -30,11 +30,12 @@
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
# module source files
-MSRCFILES = ftail.scm
+MSRCFILES = ftail.scm mtconfigf.scm
+# mtcommon.scm mtdb.scm
# Eggs to install (straightforward ones)
EGGS=matchable readline apropos base64 regex-literals format regex-case test coops trace csv \
dot-locking posix-utils posix-extras directory-utils hostinfo tcp-server rpc csv-xml fmt \
json md5 awful http-client spiffy uri-common intarweb spiffy-request-vars \
@@ -43,15 +44,14 @@
GUISRCF = dashboard-context-menu.scm dashboard-tests.scm dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm vg.scm
OFILES = $(SRCFILES:%.scm=%.o)
GOFILES = $(GUISRCF:%.scm=%.o)
-MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
+MOFILES = $(MSRCFILES:%.scm=%.o)
-mofiles/%.o : %.scm
- mkdir -p mofiles
- csc $(CSCOPTS) -J -c $< -o mofiles/$*.o
+%.o : %.scm ../adat.scm
+ csc $(CSCOPTS) -J -c $< -o $*.o
ADTLSCR=mt_laststep mt_runstep mt_ezstep
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')
@@ -71,25 +71,38 @@
PNGFILES = $(shell cd docs/manual;ls *png)
#all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut ndboard
all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut
-mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) mofiles/ftail.o
+mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES)
csc $(CSCOPTS) $(OFILES) $(MOFILES) megatest.o -o mtest
showmtesthash:
@echo $(MTESTHASH)
dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES)
csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) -o dboard
-ndboard : newdashboard.scm $(OFILES) $(GOFILES)
- csc $(CSCOPTS) $(OFILES) $(GOFILES) newdashboard.scm -o ndboard
+mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm
+ csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut
-mtut: $(OFILES) megatest-fossil-hash.scm mtut.scm
- csc $(CSCOPTS) $(OFILES) mtut.scm -o mtut
+# Needed only for adat.scm
+OPENSRC_DIR=../opensrc
+MTUTILS_DIR=$(OPENSRC_DIR)/mtutils
+../adat.scm : $(MTUTILS_DIR)/adat.scm
+ ln -sf $(PWD)/$< $@
+# # stuff for handling external files from opensrc package
+# mtcommon.scm : $(MTUTILS_DIR)/mtcommon/mtcommon.scm
+# ln -sf $< $@
+#
+# mtdb.scm : $(MTUTILS_DIR)/mtdb/mtdb.scm
+# ln -sf $< $@
+#
+# mtconfigf.scm : $(MTUTILS_DIR)/mtconfigf/mtconfigf.scm
+# ln -sf $< $@
+#
TCMTOBJS = \
api.o \
archive.o \
cgisetup/models/pgdb.o \
client.o \
@@ -114,11 +127,11 @@
server.o \
tasks.o \
tdb.o \
tests.o \
subrun.o \
-
+ mtconfigf.o
tcmt : $(TCMTOBJS) tcmt.scm
csc $(CSCOPTS) $(TCMTOBJS) tcmt.scm -o tcmt
# install documentation to $(PREFIX)/docs
@@ -136,18 +149,18 @@
$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
mkdir -p $(PREFIX)/share/db
$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
-#multi-dboard : multi-dboard.scm $(OFILES) $(GOFILES)
-# csc $(CSCOPTS) $(OFILES) $(GOFILES) multi-dboard.scm -o multi-dboard
-
-#
-# $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm
-# csc utils/revtagfsl.scm -o $(PREFIX)/bin/revtagfsl
-
+#
# Special dependencies for the includes
+#
+
+# anything that depends on the special MOFILES needs to be listed on the left here
+launch.o : $(MOFILES)
+mtconfigf.o : $(MTUTILS_DIR)/mtconfigf/mtconfigf.scm
+
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
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
@@ -297,11 +310,14 @@
$(MTQA_FOSSIL) :
fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL)
clean :
- rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
+ rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest \
+ $(PREFIX)/dashboard mtest mtutil dboard dboard.o megatest.o dashboard.o \
+ megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o mtut.o \
+ *.import.scm mofiles/*.import.scm *.bak *~ *-original *-merge *-baseline
#======================================================================
# Make the records files
#======================================================================
Index: TODO
==================================================================
--- TODO
+++ TODO
@@ -18,15 +18,51 @@
TODO
====
. Dashboard should resist running from non-homehost
-
-
Migration to inmem db plus per run db
-------------------------------------
. Re-work the dbstruct data structure?
.. Move main.db to global?
.. [ run-id.db inmemdb last-mod last-read last-sync inuse ]
. Re-work all queries to use run-id to dereference server
. Open main.db directly in calls to -runtests etc. No need to talk remote?
+
+archive.scm:(declare (uses common))
+client.scm:(declare (uses common))
+dashboard-context-menu.scm:(declare (uses common))
+dashboard-guimonitor.scm:(declare (uses common))
+dashboard-tests.scm:(declare (uses common))
+dashboard.scm:(declare (uses common))
+db.scm:(declare (uses common))
+diff-report.scm:(declare (uses common))
+ezsteps.scm:(declare (uses common))
+fs-transport.scm:(declare (uses common))
+http-transport.scm:(declare (uses common))
+index-tree.scm:(declare (uses common))
+items.scm:(declare (uses common))
+keys.scm:(declare (uses common))
+launch.scm:(declare (uses common))
+lock-queue.scm:(declare (uses common))
+margs.scm:;; (declare (uses common))
+megatest.scm:(declare (uses common))
+mlaunch.scm:(declare (uses common))
+monitor.scm:(declare (uses common))
+mt.scm:(declare (uses common))
+mtut-dunno.scm:(declare (uses common))
+mtut.scm:(declare (uses common))
+newdashboard.scm:(declare (uses common))
+ods.scm:(declare (uses common))
+old-tcmt.scm:(declare (uses common))
+rpc-transport.scm:(declare (uses common))
+runconfig.scm:(declare (uses common))
+runs.scm:(declare (uses common))
+sauthorize.scm:;(declare (uses common))
+server.scm:(declare (uses common))
+sretrieve.scm:;(declare (uses common))
+subrun.scm:(declare (uses common))
+tasks.scm:(declare (uses common))
+tcmt.scm:(declare (uses common))
+tdb.scm:(declare (uses common))
+tests.scm:(declare (uses common))
Index: cgisetup/models/pgdb.scm
==================================================================
--- cgisetup/models/pgdb.scm
+++ cgisetup/models/pgdb.scm
@@ -17,12 +17,12 @@
;; along with Megatest. If not, see .
;;======================================================================
(declare (unit pgdb))
-;; (declare (uses configf))
-(use (prefix mtconfigf configf:))
+(declare (uses mtconfigf))
+(import (prefix mtconfigf configf:))
;; I don't know how to mix compilation units and modules, so no module here.
;;
;; (module pgdb
;; (
Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -26,18 +26,20 @@
(use canvas-draw)
(import canvas-draw-iup)
(use ducttape-lib)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct
(import (prefix sqlite3 sqlite3:))
-(use (prefix mtconfigf configf:))
(declare (uses common))
(declare (uses margs))
(declare (uses keys))
(declare (uses items))
(declare (uses db))
-;; (declare (uses configf))
+
+(declare (uses mtconfigf))
+(import (prefix mtconfigf configf:))
+
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses dashboard-guimonitor))
Index: ftail.scm
==================================================================
--- ftail.scm
+++ ftail.scm
@@ -17,10 +17,11 @@
;; along with Megatest. If not, see .
;;======================================================================
(declare (unit ftail))
+
(module ftail
(
open-tail-db
tail-write
Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -21,11 +21,11 @@
;;
;;======================================================================
(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables csv)
(use typed-records pathname-expand matchable)
-(use (prefix mtconfigf configf:))
+;; (use (prefix mtconfigf configf:))
(import (prefix base64 base64:))
(import (prefix sqlite3 sqlite3:))
(declare (unit launch))
@@ -32,10 +32,13 @@
(declare (uses subrun))
(declare (uses common))
;; (declare (uses configf))
(declare (uses db))
+(declare (uses mtconfigf))
+(import (prefix mtconfigf configf:))
+
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
;;======================================================================
@@ -69,11 +72,11 @@
;; the comment can be set in the step record in launch.scm
;;
(define (launch:load-logpro-dat run-id test-id stepname)
(let ((cname (conc stepname ".dat")))
(if (common:file-exists? cname)
- (let* ((dat (read-config cname #f #f))
+ (let* ((dat (configf:read-config cname #f #f))
(csvr (db:logpro-dat->csv dat stepname))
(csvt (let-values (((fmt-cell fmt-record fmt-csv) (make-format ",")))
(fmt-csv (map list->csv-record csvr))))
(status (configf:lookup dat "final" "exit-status"))
(msg (configf:lookup dat "final" "message")))
@@ -643,11 +646,11 @@
;; NOTE: Current order is to process runconfigs *before* setting the MT_ vars. This
;; seems non-ideal but could well break stuff
;; BUG? BUG? BUG?
(let ((rconfig (full-runconfigs-read)) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: (list "default" target))))
- (wconfig (read-config "waivers.config" #f #t sections: `( "default" ,target )))) ;; read the waivers config if it exists
+ (wconfig (configf:read-config "waivers.config" #f #t sections: `( "default" ,target )))) ;; read the waivers config if it exists
;; (setup-env-defaults (conc *toppath* "/runconfigs.config") run-id (make-hash-table) keyvals target)
;; (set-run-config-vars run-id keyvals target) ;; (db:get-target db run-id))
;; Now have runconfigs data loaded, set environment vars
(for-each
(lambda (section)
@@ -957,19 +960,19 @@
;; we have all the info needed to fully process runconfigs and megatest.config
((and ;; (not force-reread) ;; force-reread is irrelevant in the AND, could however OR it?
mtcachef
rccachef) ;; BB- why are we doing this without asking if caching is desired?
;;(BB> "launch:setup-body -- cond branch 2")
- (let* ((first-pass (find-and-read-config ;; NB// sets MT_RUN_AREA_HOME as side effect
+ (let* ((first-pass (configf:find-and-read-config ;; NB// sets MT_RUN_AREA_HOME as side effect
mtconfig
environ-patt: "env-override"
given-toppath: toppath
pathenvvar: "MT_RUN_AREA_HOME"))
(first-rundat (let ((toppath (if toppath
toppath
(car first-pass))))
- (read-config ;; (conc toppath "/runconfigs.config") ;; this should be converted to runconfig:read but it is non-trivial, leaving it for now.
+ (configf:read-config ;; (conc toppath "/runconfigs.config") ;; this should be converted to runconfig:read but it is non-trivial, leaving it for now.
(conc (if (string? toppath)
toppath
(get-environment-variable "MT_RUN_AREA_HOME"))
"/runconfigs.config")
*runconfigdat* #t
@@ -993,20 +996,20 @@
(key-vals (keys:target->keyval keys target))
(linktree (common:get-linktree)) ;; (or (getenv "MT_LINKTREE")(if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))
; (if *configdat*
; (configf:lookup *configdat* "setup" "linktree")
; (conc *toppath* "/lt"))))
- (second-pass (find-and-read-config
+ (second-pass (configf:find-and-read-config
mtconfig
environ-patt: "env-override"
given-toppath: toppath
pathenvvar: "MT_RUN_AREA_HOME"))
(runconfigdat (begin ;; this read of the runconfigs will see any adjustments made by re-reading megatest.config
(for-each (lambda (kt)
(setenv (car kt) (cadr kt)))
key-vals)
- (read-config (conc toppath "/runconfigs.config") *runconfigdat* #t ;; consider using runconfig:read some day ...
+ (configf:read-config (conc toppath "/runconfigs.config") *runconfigdat* #t ;; consider using runconfig:read some day ...
sections: sections)))
(cachefiles (launch:get-cache-file-paths areapath toppath target mtconfig))
(mtcachef (car cachefiles))
(rccachef (cdr cachefiles)))
;; trap exception due to stale NFS handle -- Error: (open-output-file) cannot open file - Stale NFS file handle: "/p/fdk/gwa/lefkowit/mtTesting/qa/primbeqa/links/p1222/11/PDK_r1.1.1/prim/clean/pcell_testgen/.runconfigs.cfg-1.6427-7d1e789cb3f62f9cde719a4865bb51b3c17ea853" - ticket 220546342
@@ -1031,19 +1034,19 @@
;; else read what you can and set the flag accordingly
;; here we don't have either mtconfig or rccachef
(else
;;(BB> "launch:setup-body -- cond branch 3 - else")
- (let* ((cfgdat (find-and-read-config
+ (let* ((cfgdat (configf:find-and-read-config
(or (args:get-arg "-config") "megatest.config")
environ-patt: "env-override"
given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
pathenvvar: "MT_RUN_AREA_HOME")))
(if (and cfgdat (list? cfgdat) (> (length cfgdat) 0) (hash-table? (car cfgdat)))
(let* ((toppath (or (get-environment-variable "MT_RUN_AREA_HOME")(cadr cfgdat)))
- (rdat (read-config (conc toppath ;; convert this to use runconfig:read!
+ (rdat (configf:read-config (conc toppath ;; convert this to use runconfig:read!
"/runconfigs.config") *runconfigdat* #t sections: sections)))
(set! *configinfo* cfgdat)
(set! *configdat* (car cfgdat))
(set! *runconfigdat* rdat)
(set! *toppath* toppath)
@@ -1113,11 +1116,11 @@
;; if have -append-config then read and append here
(let ((cfname (args:get-arg "-append-config")))
(if (and cfname
(file-read-access? cfname))
- (read-config cfname *configdat* #t))) ;; values are added to the hash, no need to do anything special.
+ (configf:read-config cfname *configdat* #t))) ;; values are added to the hash, no need to do anything special.
*toppath*)))
(define (get-best-disk confdat testconfig)
(let* ((disks (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
(hash-table-ref/default confdat "disks" #f)))
Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -53,10 +53,12 @@
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
(declare (uses ftail))
(import ftail)
+(declare (uses mtconfigf))
+(import (prefix mtconfigf configf:))
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
(include "common_records.scm")
(include "key_records.scm")
@@ -1888,11 +1890,16 @@
(run-id (assoc/default 'run-id cmdinfo))
(test-id (assoc/default 'test-id cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
(work-area (assoc/default 'work-area cmdinfo))
(db #f))
- (change-directory testpath)
+ (handle-exceptions
+ exn
+ (begin
+ (debug:print 0 *default-log-port* "ERROR: the work directory " testpath " has disappeared or become unreadable! Cannot proceed, exiting now.")
+ (exit 1))
+ (change-directory testpath))
(if (not (launch:setup))
(begin
(debug:print 0 *default-log-port* "Failed to setup, exiting")
(exit 1)))
(if (and state status)
Index: mtut.scm
==================================================================
--- mtut.scm
+++ mtut.scm
@@ -20,21 +20,24 @@
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
-(use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
- srfi-19 srfi-18 extras format pkts regex regex-case
+(use srfi-1 posix srfi-69 readline
+ srfi-19 srfi-18 extras format
+ pkts regex regex-case
(prefix dbi dbi:)
- nanomsg
- (prefix mtconfigf configf:))
+ nanomsg)
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
-;; (declare (uses configf))
;; (declare (uses rmt))
+
+;; mtconfigf is compiled in as a compilation unit
+(declare (uses mtconfigf))
+(import (prefix mtconfigf configf:))
(use ducttape-lib)
(include "megatest-fossil-hash.scm")