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
@@ -535,17 +533,27 @@
fi
# 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
+# IMPORTSTUBS = $(*import.scm:%.scm=%)
+
+unitdeps.dot : *mod.scm ./utils/plot-uses Makefile
+ ./utils/plot-uses todot processmod.import,dbfile.import,dbmod.import,configfmod.import,mtmod.import,procesmod.import,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
+ tred unitdeps.dot > unitdeps-tred.dot
+ dot unitdeps-tred.dot -Tpdf -o unitdeps.pdf
./utils/plot-uses : utils/plot-uses.scm
csc utils/plot-uses.scm
# create a pdf dot graphviz diagram from notations in rmt.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: apimod.scm
==================================================================
--- apimod.scm
+++ apimod.scm
@@ -311,15 +311,19 @@
((cmd run-id params meta)
(let* ((start-t (current-milliseconds))
;; factor this out and move before this let, it is just
;; an assert if not ping and dbfname is not correct
(db-ok (let* ((dbfname (dbmod:run-id->dbfname run-id))
- (ok (equal? dbfname (dbr:dbstruct-dbfname dbstruct))))
+ (ok (equal? dbfname (dbr:dbstruct-dbfname dbstruct)))
+ (message ""))
(case cmd
((ping) #t) ;; we are fine
(else
- (assert ok "FATAL: database file and run-id not aligned.")))))
+ (begin
+ (set! message (conc "tcp request handler: dbstruct database file " (dbr:dbstruct-dbfname dbstruct) " not aligned with run-id " run-id))
+ (assert ok message)))))
+ )
(ttdat *server-info*)
(server-state (tt-state ttdat))
(status 'ok) ;; anything legit we can do with status?
(delay-wait 0)
(result (if (eq? cmd 'ping)
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
@@ -122,11 +122,11 @@
typed-records
z3
)
(include "common_records.scm")
-(include "db_records.scm")
+;; (include "db_records.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: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -133,10 +133,14 @@
;;
;;======================================================================
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
+(include "db_records.scm")
+(include "key_records.scm")
+(include "common_records.scm")
+(include "test_records.scm")
;; http - use the old http + in /tmp db
;; tcp - use tcp transport with cachedb db
;; nfs - use direct to disk access (read-only)
;;
@@ -626,13 +630,10 @@
;;======================================================================
;; old stuff from keys.scm
;;======================================================================
-(include "key_records.scm")
-(include "common_records.scm")
-
(define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...
(string-intersperse keys ","))
;; (define (args:usage . a) #f)
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:))
@@ -45,19 +45,21 @@
(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))
(include "common_records.scm")
-(include "db_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
(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,16 +32,15 @@
(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")
+;; (include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(define (control-panel db tdb keys)
(let* ((var-params (make-hash-table)) ;; register all the widgets here for querying on run, rollup, remove?
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))
@@ -63,11 +62,11 @@
runsmod
subrunmod
)
(include "common_records.scm")
-(include "db_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
;;======================================================================
;; C O M M O N
;;======================================================================
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))
@@ -109,11 +108,11 @@
runsmod
testsmod
)
(include "common_records.scm")
-(include "db_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")
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
@@ -80,12 +80,12 @@
debugprint
mtmod
)
(include "common_records.scm")
-(include "db_records.scm")
-(include "key_records.scm")
+;; (include "db_records.scm")
+;; (include "key_records.scm")
(include "run_records.scm")
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)
@@ -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))
@@ -42,12 +41,12 @@
dbmod
debugprint)
(include "megatest-version.scm")
(include "common_records.scm")
-(include "db_records.scm")
-(include "key_records.scm")
+;; (include "db_records.scm")
+;; (include "key_records.scm")
(include "run_records.scm")
;; yes, this is non-ideal
(define dashboard:update-summary-tab #f)
(define dashboard:update-servers-table #f)
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))
Index: ezstepsmod.scm
==================================================================
--- ezstepsmod.scm
+++ ezstepsmod.scm
@@ -127,12 +127,12 @@
runsmod
fsmod
)
(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
;;(rmt:get-test-info-by-id run-id test-id) -> testdat
Index: genexample.scm
==================================================================
--- genexample.scm
+++ genexample.scm
@@ -31,11 +31,11 @@
commonmod
configfmod
rmtmod
debugprint)
-(include "db_records.scm")
+;; (include "db_records.scm")
(define genexample:example-logpro
#<.
-
-
-;; (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: key_records.scm
==================================================================
--- key_records.scm
+++ key_records.scm
@@ -16,17 +16,17 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;======================================================================
-(define-inline (keys->valslots keys) ;; => ?,?,? ....
+(define (keys->valslots keys) ;; => ?,?,? ....
(string-intersperse (map (lambda (x) "?") keys) ","))
-;; (define-inline (keys->key/field keys . additional)
+;; (define (keys->key/field keys . additional)
;; (string-join (map (lambda (k)(conc k " TEXT"))
;; (append keys additional)) ","))
-(define-inline (item-list->path itemdat)
+(define (item-list->path itemdat)
(if (list? itemdat)
(string-intersperse (map cadr itemdat) "/")
""))
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))
@@ -48,12 +47,12 @@
(prefix sqlite3 sqlite3:)
(prefix mtargs args:)
)
(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "megatest-fossil-hash.scm")
(import commonmod
processmod
configfmod
Index: launchmod.scm
==================================================================
--- launchmod.scm
+++ launchmod.scm
@@ -127,12 +127,12 @@
runsmod
fsmod
)
(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "megatest-fossil-hash.scm")
;;======================================================================
;; ezsteps
;;======================================================================
@@ -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
@@ -68,32 +68,29 @@
(declare (uses subrunmod))
(declare (uses subrunmod.import))
(declare (uses archivemod))
(declare (uses archivemod.import))
(declare (uses runsmod))
+;; comment out following line for performance, but debug result.
(declare (uses runsmod.import))
(declare (uses cpumod))
(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))
@@ -123,12 +120,12 @@
)
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:))
(use readline apropos json http-client directory-utils typed-records)
Index: monitor.scm
==================================================================
--- monitor.scm
+++ monitor.scm
@@ -19,17 +19,16 @@
(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")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "run_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))
@@ -44,13 +42,13 @@
;; make mt: calls in megatestmod work
;; (read-config-set! read-config)
(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
-(include "test_records.scm")
+;; (include "test_records.scm")
;; This is the Megatest API. All generally "useful" routines will be wrapped or extended
;; here.
Index: mtmod.scm
==================================================================
--- mtmod.scm
+++ mtmod.scm
@@ -109,11 +109,11 @@
)))
;; imports common to chk5 and ck4
(import srfi-13)
-(include "db_records.scm")
+;; (include "db_records.scm")
;;======================================================================
;; stuff from keys that can't be in commonmod. Maybe move all from commonmod to here?
;;======================================================================
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
@@ -53,11 +53,11 @@
apimod
mtmod
servermod
)
-(include "db_records.scm")
+;; (include "db_records.scm")
(defstruct alldat
(areapath #f)
(ulexdat #f)
)
@@ -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)
@@ -45,14 +43,14 @@
sxml-modifications matchable)
(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
-(include "test_records.scm")
+;; (include "test_records.scm")
;; (include "debugger.scm")
(import commonmod
processmod
Index: runsmod.scm
==================================================================
--- runsmod.scm
+++ runsmod.scm
@@ -128,14 +128,14 @@
archivemod
fsmod
)
(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
-(include "test_records.scm")
+;; (include "test_records.scm")
;; use this struct to facilitate refactoring
;;
(defstruct runs:dat
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))
@@ -36,11 +35,11 @@
configfmod
debugprint
(prefix mtargs args:))
(include "common_records.scm")
-(include "db_records.scm")
+;; (include "db_records.scm")
(define (db:kill-servers)
(let* ((tl (launch:setup)) ;; need this to initialize *toppath*
(servdir (conc *toppath* "/.servinfo"))
(servfiles (glob (conc servdir "/*:*.db")))
Index: servermod.scm
==================================================================
--- servermod.scm
+++ servermod.scm
@@ -47,11 +47,11 @@
(prefix mtargs args:)
mtmod
)
(include "common_records.scm")
-(include "db_records.scm")
+;; (include "db_records.scm")
(define (server:make-server-url hostport)
(if (not hostport)
#f
(conc "http://" (car hostport) ":" (cadr hostport))))
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: subrunmod.scm
==================================================================
--- subrunmod.scm
+++ subrunmod.scm
@@ -121,11 +121,11 @@
tasksmod
)
;(include "common_records.scm")
;;(include "key_records.scm")
-(include "db_records.scm") ;; provides db:test-get-id
+;; (include "db_records.scm") ;; provides db:test-get-id
;;(include "run_records.scm")
;;(include "test_records.scm")
(define (subrun:subrun-test-initialized? test-run-dir)
(if (and (common:file-exists? (conc test-run-dir "/subrun-area") )
Index: tasksmod.scm
==================================================================
--- tasksmod.scm
+++ tasksmod.scm
@@ -115,11 +115,11 @@
mtmod
megatestmod
)
(include "task_records.scm")
-(include "db_records.scm")
+;; (include "db_records.scm")
;;======================================================================
;; Tasks db
;;======================================================================
Index: tcmt.scm
==================================================================
--- tcmt.scm
+++ tcmt.scm
@@ -39,11 +39,11 @@
rmtmod
(prefix mtargs args:))
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
-(include "db_records.scm")
+;; (include "db_records.scm")
(define origargs (cdr (argv)))
(define remargs (args:get-args
(argv)
`( "-target"
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)
@@ -42,12 +40,12 @@
debugprint
rmtmod
(prefix mtargs args:))
(include "common_records.scm")
-(include "db_records.scm")
-(include "key_records.scm")
+;; (include "db_records.scm")
+;; (include "key_records.scm")
(include "run_records.scm")
;;======================================================================
;;
;; T E S T D A T A B A S E S
Index: test_records.scm
==================================================================
--- test_records.scm
+++ test_records.scm
@@ -15,22 +15,22 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;; make-vector-record tests testqueue testname testconfig waitons priority items
(define (make-tests:testqueue)(make-vector 7 #f))
-(define-inline (tests:testqueue-get-testname vec) (vector-ref vec 0))
-(define-inline (tests:testqueue-get-testconfig vec) (vector-ref vec 1))
-(define-inline (tests:testqueue-get-waitons vec) (vector-ref vec 2))
-(define-inline (tests:testqueue-get-priority vec) (vector-ref vec 3))
-;; items: #f=no items, list=list of items remaining, proc=need to call to get items
-(define-inline (tests:testqueue-get-items vec) (vector-ref vec 4))
-(define-inline (tests:testqueue-get-itemdat vec) (vector-ref vec 5))
-(define-inline (tests:testqueue-get-item_path vec) (vector-ref vec 6))
-
-(define-inline (tests:testqueue-set-testname! vec val)(vector-set! vec 0 val))
-(define-inline (tests:testqueue-set-testconfig! vec val)(vector-set! vec 1 val))
-(define-inline (tests:testqueue-set-waitons! vec val)(vector-set! vec 2 val))
-(define-inline (tests:testqueue-set-priority! vec val)(vector-set! vec 3 val))
-(define-inline (tests:testqueue-set-items! vec val)(vector-set! vec 4 val))
-(define-inline (tests:testqueue-set-itemdat! vec val)(vector-set! vec 5 val))
-(define-inline (tests:testqueue-set-item_path! vec val)(vector-set! vec 6 val))
+(define (tests:testqueue-get-testname vec) (vector-ref vec 0))
+(define (tests:testqueue-get-testconfig vec) (vector-ref vec 1))
+(define (tests:testqueue-get-waitons vec) (vector-ref vec 2))
+(define (tests:testqueue-get-priority vec) (vector-ref vec 3))
+;; items: #f=no items, list=list of items remaining, proc=need to call to get items
+(define (tests:testqueue-get-items vec) (vector-ref vec 4))
+(define (tests:testqueue-get-itemdat vec) (vector-ref vec 5))
+(define (tests:testqueue-get-item_path vec) (vector-ref vec 6))
+
+(define (tests:testqueue-set-testname! vec val)(vector-set! vec 0 val))
+(define (tests:testqueue-set-testconfig! vec val)(vector-set! vec 1 val))
+(define (tests:testqueue-set-waitons! vec val)(vector-set! vec 2 val))
+(define (tests:testqueue-set-priority! vec val)(vector-set! vec 3 val))
+(define (tests:testqueue-set-items! vec val)(vector-set! vec 4 val))
+(define (tests:testqueue-set-itemdat! vec val)(vector-set! vec 5 val))
+(define (tests:testqueue-set-item_path! vec val)(vector-set! vec 6 val))
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: testsmod.scm
==================================================================
--- testsmod.scm
+++ testsmod.scm
@@ -126,14 +126,14 @@
servermod
fsmod
)
(include "common_records.scm")
-(include "key_records.scm")
-(include "db_records.scm")
+;; (include "key_records.scm")
+;; (include "db_records.scm")
(include "run_records.scm")
-(include "test_records.scm")
+;; (include "test_records.scm")
(include "js-path.scm")
(define (init-java-script-lib)
(set! *java-script-lib* (conc (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js"))
)
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)
@@ -38,12 +37,12 @@
(import (prefix mtargs args:)
debugprint)
(include "megatest-version.scm")
(include "common_records.scm")
-(include "db_records.scm")
-(include "key_records.scm")
+;; (include "db_records.scm")
+;; (include "key_records.scm")
;;======================================================================
;; T R E E S T U F F
;;======================================================================