Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -143,11 +143,11 @@
$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
mkdir -p $(PREFIX)/share/db
$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
# Special dependencies for the includes
-common.o : commonmod.o
+common.o : mofiles/commonmod.o
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
@@ -164,10 +164,11 @@
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
mofiles/stml2.o : mofiles/cookie.o
+configf.o : mofiles/commonmod.o
vg.o dashboard.o : vg_records.scm
dcommon.o : run_records.scm
@@ -202,12 +203,15 @@
# specific rules for .o files that genuninely depend on mofiles/something
#
megatest.o : megatest.scm stml2.o mutils.o commonmod.o
csc $(CSCOPTS) -c megatest.scm stml2.o mutils.o commonmod.o
-common.o : megatest.scm commonmod.o
- csc $(CSCOPTS) -c common.scm commonmod.o
+common.o : megatest.scm mofiles/commonmod.o common.scm
+ csc $(CSCOPTS) -c common.scm mofiles/commonmod.o
+
+configf.o : configf.scm mofiles/commonmod.o
+ csc $(CSCOPTS) -c configf.scm mofiles/commonmod.o
$(PREFIX)/bin/.$(ARCHSTR)/mtest : mtest utils/mk_wrapper
@echo Installing to PREFIX=$(PREFIX)
$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/mtest
utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest
@@ -342,11 +346,11 @@
clean :
rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) \
$(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut \
tcmt readline-fix.scm serialize-env dboard dboard.o \
megatest.o dashboard.o megatest-fossil-hash.* altdb.scm \
- mofiles/*.o vg.o commonmod.o cookie.o dashboard-main.o \
+ mofiles/*.o vg.o cookie.o dashboard-main.o \
ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o \
tcmt.o
rm -rf share
#======================================================================
Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -26,12 +26,13 @@
(prefix sqlite3 sqlite3:)
(prefix dbi dbi:)
)
(declare (unit common))
-;; (declare (uses commonmod))
-;; (import commonmod)
+(declare (uses commonmod))
+(import (prefix commonmod cmod:))
+
(import pkts)
(include "common_records.scm")
@@ -874,16 +875,11 @@
(define (assoc/default key lst . default)
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
(define (common:get-testsuite-name)
- (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
- (configf:lookup *configdat* "setup" "testsuite" )
- (getenv "MT_TESTSUITE_NAME")
- (if (string? *toppath* )
- (pathname-file *toppath*)
- #f))) ;; (pathname-file (current-directory)))))
+ (cmod:get-testsuite-name *toppath* *configdat*))
;; safe getting of toppath
(define (common:get-toppath areapath)
(or *toppath*
(if areapath
Index: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -21,15 +21,35 @@
(declare (unit commonmod))
(module commonmod
*
-(import scheme chicken data-structures extras)
-(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
+(import scheme chicken data-structures extras files)
+(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69)
(define (just-testing)
(print "JUST TESTING"))
+
+(define (lookup cfgdat section var)
+ (if (hash-table? cfgdat)
+ (let ((sectdat (hash-table-ref/default cfgdat section '())))
+ (if (null? sectdat)
+ #f
+ (let ((match (assoc var sectdat)))
+ (if match ;; (and match (list? match)(> (length match) 1))
+ (cadr match)
+ #f))
+ ))
+ #f))
+
+(define (get-testsuite-name toppath configdat)
+ (or (lookup configdat "setup" "area-name")
+ (lookup configdat "setup" "testsuite")
+ (get-environment-variable "MT_TESTSUITE_NAME")
+ (if (string? toppath)
+ (pathname-file toppath)
+ #f)))
;; (define (debug:print . params) #f)
;; (define (debug:print-info . params) #f)
;;
;; (define (set-functions dbgp dbgpinfo)
Index: configf.scm
==================================================================
--- configf.scm
+++ configf.scm
@@ -9,11 +9,11 @@
;; (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.
+;; GNnU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;======================================================================
@@ -25,10 +25,13 @@
(use regex regex-case matchable) ;; directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses keys))
+(declare (uses commonmod))
+
+(import (prefix commonmod cmod:))
(include "common_records.scm")
;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
@@ -499,33 +502,24 @@
(let ((configdat (if configfile
(read-config configfile #f #t environ-patt: environ-patt post-section-procs: (list (cons "^fields$" set-fields)) #f))))
(if toppath (change-directory curr-dir))
(list configdat toppath configfile fname))))
-(define (configf:lookup cfgdat section var)
- (if (hash-table? cfgdat)
- (let ((sectdat (hash-table-ref/default cfgdat section '())))
- (if (null? sectdat)
- #f
- (let ((match (assoc var sectdat)))
- (if match ;; (and match (list? match)(> (length match) 1))
- (cadr match)
- #f))
- ))
- #f))
-
;; use to have definitive setting:
;; [foo]
;; var yes
;;
;; (configf:var-is? cfgdat "foo" "var" "yes") => #t
;;
(define (configf:var-is? cfgdat section var expected-val)
(equal? (configf:lookup cfgdat section var) expected-val))
-(define config-lookup configf:lookup)
+;; (define config-lookup configf:lookup)
(define configf:read-file read-config)
+
+(define (configf:lookup cfgdat section var)
+ (cmod:lookup cfgdat section var))
;; safely look up a value that is expected to be a number, return
;; a default (#f unless provided)
;;
(define (configf:lookup-number cfdat section varname #!key (default #f))
ADDED dbmod.scm
Index: dbmod.scm
==================================================================
--- /dev/null
+++ dbmod.scm
@@ -0,0 +1,39 @@
+;;======================================================================
+;; Copyright 2017, 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 .
+
+;;======================================================================
+
+(declare (unit commonmod))
+
+(module commonmod
+ *
+
+(import scheme chicken data-structures extras)
+(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
+
+(define (just-testing)
+ (print "JUST TESTING"))
+
+;; (define (debug:print . params) #f)
+;; (define (debug:print-info . params) #f)
+;;
+;; (define (set-functions dbgp dbgpinfo)
+;; (set! debug:print dbgp)
+;; (set! debug:print-info dbgpinfo))
+
+)