Megatest

#            subrun.scm portlogger.scm archive.scm env.scm		\
#            diff-report.scm cgisetup/models/pgdb.scm

# module source files
# MSRCFILES = 
# ftail.scm rmtmod.scm commonmod.scm removed
MSRCFILES = autoload.scm dbi.scm ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \
            mtargs.scm apimod.scm  commonmod.scm  dbmod.scm rmtmod.scm

# commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
#            rmtmod.scm apimod.scm

GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\
          dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm	\
          vg.scm

mofiles/%.o : %.scm
	mkdir -p mofiles
	csc $(CSCOPTS) -J -c $< -o mofiles/$*.o

# module dependencies
mofiles/stml2.o : mofiles/dbi.o
mofiles/dbi.o   : mofiles/autoload.o
mofiles/apimod.o mofiles/dbmod.o mofiles/rmtmod.o : mofiles/commonmod.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}')

ifeq ($(MTESTHASH),)

;;     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 apimod))
(declare (uses commonmod))


(module apimod
	*
	
(import scheme
	(prefix sqlite3 sqlite3:)

	typed-records
	srfi-18

	commonmod

	)


)

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

(declare (unit commonmod))

(module commonmod
	*
	
(import scheme chicken.base
	(prefix sqlite3 sqlite3:)
	
	typed-records
	md5
	message-digest
	regex

	srfi-1
	srfi-18
	srfi-69

	)

;;======================================================================
;; CONTENTS
;;
;;  config file utils
;;  misc conversion, data manipulation functions
;;  testsuite and area utilites
;;
;;======================================================================

(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")

;; (define (get-full-version)
;;   (conc megatest-version "-" megatest-fossil-hash))
;; 
;; (define (version-signature)
;;   (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
;; 
;; 
;; ;;======================================================================
;; ;; config file utils
;; ;;======================================================================
;; 
;; (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))
;; 
;; ;; returns var key1=val1; key2=val2 ... as alist
;; (define (get-key-list cfgdat section var)
;;   ;; convert string a=1; b=2; c=a silly thing; d=
;;   (let ((valstr (lookup cfgdat section var)))
;;     (if valstr
;; 	(val->alist valstr)
;; 	'()))) ;; should it return empty list or #f to indicate not set?
;; 
;; 
;; (define (get-section cfgdat section)
;;   (hash-table-ref/default cfgdat section '()))
;; 
;; ;;======================================================================
;; ;; misc conversion, data manipulation functions
;; ;;======================================================================
;; 
;; ;; if it looks like a number -> convert it to a number, else return it
;; ;;
;; (define (lazy-convert inval)
;;   (let* ((as-num (if (string? inval)(string->number inval) #f)))
;;     (or as-num inval)))
;; 
;; ;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
;; ;;
;; (define (val->alist val #!key (convert #f))
;;   (let ((val-list (string-split-fields ";\\s*" val #:infix)))
;;     (if val-list
;; 	(map (lambda (x)
;; 	       (let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
;; 		 (case (length f)
;; 		   ((0) `(,#f))  ;; null string case
;; 		   ((1) `(,(string->symbol (car f))))
;; 		   ((2) `(,(string->symbol (car f)) .
;; 			  ,(let ((inval (cadr f)))
;; 			     (if convert (lazy-convert inval) inval))))
;; 		   (else f))))
;; 	     (filter (lambda (x)
;; 		       (not (string-match "^\\s*" x)))
;; 		     val-list))
;; 	'())))
;; 
;; ;;======================================================================
;; ;; testsuite and area utilites
;; ;;======================================================================
;; 
;; (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 (get-area-path-signature toppath #!optional (short #f))
;;   (let ((res (message-digest-string (md5-primitive) toppath)))
;;     (if short
;; 	(substring res 0 4)
;; 	res)))
;; 
;; (define (get-area-name configdat toppath #!optional (short #f))
;;   ;; look up my area name in areas table (future)
;;   ;; generate auto name
;;   (conc (get-area-path-signature toppath short)
;; 	"-"
;; 	(get-testsuite-name toppath configdat)))


;; 
;; ;; need generic find-record-with-var-nmatching-val
;; ;;
;; (define (path->area-record cfgdat path)
;;   (let* ((areadat (get-cfg-areas cfgdat))
;; 	 (all     (filter (lambda (x)
;; 			    (let* ((keyvals (cdr x))
;; 				   (pth     (alist-ref 'path keyvals)))
;; 			      (equal? path pth)))
;; 			  areadat)))
;;     (if (null? all)
;; 	#f
;; 	(car all)))) ;; return first match
;; 
;; ;; given a config return an alist of alists
;; ;;   area-name => data
;; ;;
;; (define (get-cfg-areas cfgdat)
;;   (let ((adat (get-section cfgdat "areas")))
;;     (map (lambda (entry)
;; 	   `(,(car entry) . 
;; 	     ,(val->alist (cadr entry))))
;; 	 adat)))
;; 	 
;; ;; (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))

)

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

(declare (unit dbmod))

(module dbmod
	*
	
(import scheme
	(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)
;; 

(declare (uses mutils))
(declare (uses autoload))
(declare (uses pkts))
(declare (uses ducttape-lib))
(declare (uses stml2))
(declare (uses cookie))
(declare (uses mtargs))
(declare (uses commonmod))
(declare (uses apimod))
(declare (uses dbmod))
(declare (uses rmtmod))


;; (include "call-with-environment-variables/call-with-environment-variables.scm")

(module megatest-main
	*

	(import scheme

(declare (uses ulex))

;; (include "ulex/ulex.scm")

(module rmtmod
	*
	
(import scheme 
	(prefix sqlite3 sqlite3:)
	posix
	typed-records
	srfi-18
	commonmod
	apimod

	)

(defstruct alldat
  (areapath #f)
  (ulexdat  #f)
  )

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