Megatest

# (MSRCFILES)
# shell ls *.scm adjutant.scm cgisetup/models/pgdb.scm|sort -u|egrep -v '.import.|debugprint|mtargs|sretrieve|sauth|sharedat|tcmt')

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)

;; read a line and process any #{ ... } constructs

(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)))
	  (if matchdat
	      (let* ((prestr  (list-ref matchdat 1))
		     (cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
		     (cmd     (list-ref matchdat 3))
		     (poststr (list-ref matchdat 4))
		     (result  #f)
		     (start-time (current-seconds))
		     (cmdsym  (string->symbol cmdtype))
		     (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))
		   ;; (print "exn=" (condition->list exn))
		   (set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd)))

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit dbmod))

(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses mtargs))
(declare (uses mtver))
(declare (uses csv-xml))
(declare (uses keysmod))

	keysmod
	mtmod
	mtver
	pkts
	(prefix dbi dbi:)
	)






















(include "key_records.scm")


;;======================================================================
;;  R E C O R D S
;;======================================================================

;; each db entry is a pair ( db . dbfilepath )
;; I propose this record evolves into the area record

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit mtmod))

(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))

(module mtmod
	*
	

	srfi-69
	stack
	typed-records
	z3
	
	)























;; 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)
      tests
      (begin

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

(declare (unit all))

(declare (uses mod1))
(declare (uses mod2))

(module all
	()
	(import scheme chicken.module mod1 mod2)
	(reexport mod1 mod2)

)
	 
 

(declare (unit mod1))

(module mod1
	*

(import scheme)
(define *mod1somevar* 1234)

)
	 
 

(declare (unit mod2))

(module mod2
	*

(import scheme)
(define *mod2somevar* 4321)

)
	 
 

(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