Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -430,7 +430,12 @@
deps.pdf : $(DEPSFILES)
gendeps deps.inc $(DEPSFILES)
dot deps.dot -Tpdf -o deps.pdf
+mindeps.pdf : $(DEPSFILES)
+ gendeps deps.inc $(DEPSFILES)
+ egrep -v 'debugprint|mtargs|mtver|hostinfo|stml2' deps.dot > mindeps.dot
+ dot mindeps.dot -Tpdf -o mindeps.pdf
+
showdepfiles :
@echo $(DEPSFILES)
Index: configfmod.scm
==================================================================
--- configfmod.scm
+++ configfmod.scm
@@ -1119,10 +1119,13 @@
(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get|rget|scm|sh|rp|gv|g|mtrah)\\s+([^\\}\\{]*)\\}(.*)"))
(define (configf:system ht cmd)
(system cmd)
)
+
+(define configf:std-imports "(import configfmod commonmod)")
+(module-environment configfmod)
(define (configf:process-line l ht allow-system #!key (linenum #f))
(let loop ((res l))
(if (string? res)
(let ((matchdat (string-search configf:var-expand-regex res)))
@@ -1132,31 +1135,33 @@
(cmd (list-ref matchdat 3))
(poststr (list-ref matchdat 4))
(result #f)
(start-time (current-seconds))
(cmdsym (string->symbol cmdtype))
- (fullcmd (case cmdsym
- ((scheme scm) (conc "(lambda (ht)" cmd ")"))
- ((system) (conc "(lambda (ht)(configf:system ht \"" cmd "\"))"))
- ((shell sh) (conc "(lambda (ht)(string-translate (shell \"" cmd "\") \"\n\" \" \"))"))
- ((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))"))
- ((getenv gv) (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
- ((mtrah) (conc "(lambda (ht)"
- " (let ((extra \"" cmd "\"))"
- " (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
- " (if (string-null? extra) \"\" \"/\")"
- " extra)))"))
- ((get g)
- (match (string-split cmd)
- ((sect var)(conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))"))
- (else
- (debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.")
- "(lambda (ht) #f)")))
- ((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
- ;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
- (else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
- ;; (print "fullcmd=" fullcmd)
+ (fullcmd
+ (conc configf:std-imports
+ (case cmdsym
+ ((scheme scm) (conc "(lambda (ht)" cmd ")"))
+ ((system) (conc "(lambda (ht)(configf:system ht \"" cmd "\"))"))
+ ((shell sh) (conc "(lambda (ht)(string-translate (shell \"" cmd "\") \"\n\" \" \"))"))
+ ((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))"))
+ ((getenv gv) (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
+ ((mtrah) (conc "(lambda (ht)"
+ " (let ((extra \"" cmd "\"))"
+ " (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
+ " (if (string-null? extra) \"\" \"/\")"
+ " extra)))"))
+ ((get g)
+ (match (string-split cmd)
+ ((sect var)(conc "(lambda (ht)(configf:lookup ht \"" sect "\" \"" var "\"))"))
+ (else
+ (debug:print-error 0 *default-log-port* "#{get ...} used with only one parameter, \"" cmd "\", two needed.")
+ "(lambda (ht) #f)")))
+ ((runconfigs-get rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
+ ;; ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
+ (else "(lambda (ht)(print \"ERROR\") \"ERROR\")")))))
+ (print "fullcmd=" fullcmd)
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "WARNING: failed to process config input \"" l "\", exn=" exn)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
Index: dbmod.scm
==================================================================
--- dbmod.scm
+++ dbmod.scm
@@ -17,10 +17,11 @@
;; along with Megatest. If not, see .
;;======================================================================
(declare (unit dbmod))
+
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses mtargs))
(declare (uses mtver))
@@ -75,33 +76,12 @@
mtver
pkts
(prefix dbi dbi:)
)
-;;======================================================================
-;; Database access
-;;======================================================================
-
-;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc
-
-;; (use (srfi 18) extras tcp stack)
-;; (use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3 typed-records matchable)
-;; (import (prefix sqlite3 sqlite3:))
-;; (import (prefix base64 base64:))
-;;
-;; (declare (unit db))
-;; (declare (uses common))
-;; (declare (uses keys))
-;; (declare (uses ods))
-;; (declare (uses client))
-;; (declare (uses mt))
-;;
-;; (include "common_records.scm")
-
-;; (include "db_records.scm")
-(include "key_records.scm")
-;; (include "run_records.scm")
+
+(include "key_records.scm")
;;======================================================================
;; R E C O R D S
;;======================================================================
Index: mtmod.scm
==================================================================
--- mtmod.scm
+++ mtmod.scm
@@ -17,10 +17,11 @@
;; along with Megatest. If not, see .
;;======================================================================
(declare (unit mtmod))
+
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(module mtmod
@@ -64,32 +65,10 @@
typed-records
z3
)
-
-
-;; (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils call-with-environment-variables)
-;; (import (prefix sqlite3 sqlite3:))
-;;
-;; (declare (unit mt))
-;; (declare (uses db))
-;; (declare (uses common))
-;; (declare (uses items))
-;; (declare (uses runconfig))
-;; (declare (uses tests))
-;; (declare (uses server))
-;; (declare (uses runs))
-;; (declare (uses rmt))
-;; ;; (declare (uses filedb))
-;;
-;; (include "common_records.scm")
-;; (include "key_records.scm")
-;; (include "db_records.scm")
-;; (include "run_records.scm")
-;; (include "test_records.scm")
-
;; This is the Megatest API. All generally "useful" routines will be wrapped or extended
;; here.
(define (mt:discard-blocked-tests run-id failed-test tests test-records)
(if (null? tests)
ADDED testeval/Makefile
Index: testeval/Makefile
==================================================================
--- /dev/null
+++ testeval/Makefile
@@ -0,0 +1,14 @@
+CSCOPTS=
+SRCFILES=mod1.scm mod2.scm all.scm
+MOFILES = $(SRCFILES:%.scm=%.o)
+MOIMPFILES = $(SRCFILES:%.scm=%.import.o)
+
+%.import.o : %.import.scm
+ csc $(CSCOPTS) -unit $*.import -c $*.import.scm -o $*.import.o
+
+%.o : %.scm
+ csc $(CSCOPTS) -J -c $< -o $*.o
+
+mod3.o : mod1.o mod2.o all.o
+mod3 : mod3.scm $(MOFILES)
+ csc $(CSCOPTS) $(MOFILES) mod3.scm -o mod3
ADDED testeval/all.scm
Index: testeval/all.scm
==================================================================
--- /dev/null
+++ testeval/all.scm
@@ -0,0 +1,13 @@
+(declare (unit all))
+
+(declare (uses mod1))
+(declare (uses mod2))
+
+(module all
+ ()
+ (import scheme chicken.module mod1 mod2)
+ (reexport mod1 mod2)
+
+)
+
+
ADDED testeval/mod1.scm
Index: testeval/mod1.scm
==================================================================
--- /dev/null
+++ testeval/mod1.scm
@@ -0,0 +1,11 @@
+(declare (unit mod1))
+
+(module mod1
+ *
+
+(import scheme)
+(define *mod1somevar* 1234)
+
+)
+
+
ADDED testeval/mod2.scm
Index: testeval/mod2.scm
==================================================================
--- /dev/null
+++ testeval/mod2.scm
@@ -0,0 +1,11 @@
+(declare (unit mod2))
+
+(module mod2
+ *
+
+(import scheme)
+(define *mod2somevar* 4321)
+
+)
+
+
ADDED testeval/mod3.scm
Index: testeval/mod3.scm
==================================================================
--- /dev/null
+++ testeval/mod3.scm
@@ -0,0 +1,35 @@
+
+(declare (uses mod1))
+(declare (uses mod2))
+
+(module mod3
+ *
+
+(import scheme
+ chicken.eval
+ mod1 mod2 all)
+
+(define (vars) ;;
+ (- *mod2somevar* *mod1somevar*))
+
+(define (mod1ok)
+ (let ((modallenv (module-environment 'all)))
+ (eval '*mod1somevar* modallenv)))
+
+(define (mod2ok)
+ (let ((modallenv (module-environment 'all)))
+ (eval '*mod2somevar* modallenv)))
+
+(define (addsome)
+ (let ((modallenv (module-environment 'all)))
+ (eval '(+ *mod1somevar* *mod2somevar*) modallenv)))
+
+)
+
+(import mod3)
+
+(print "vars: "(vars))
+(print "mod1ok: "(mod1ok))
+(print "mod2ok: "(mod2ok))
+(print "addsome: "(addsome)) ;; => 5555
+