Megatest

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

(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 udp ;; sql-de-lite
     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     ;; (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     (prefix dbi dbi:)
     )

(declare (unit common))
(declare (uses commonmod))
(import (prefix commonmod cmod:))

(declare (unit commonmod))

(module commonmod
	*
	
(import scheme chicken data-structures extras files)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69
	md5 message-digest)

(define (just-testing)
  (print "JUST TESTING"))

(define (lookup cfgdat section var)
  (if (hash-table? cfgdat)
      (let ((sectdat (hash-table-ref/default cfgdat section '())))

(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)
  (message-digest-string (md5-primitive) toppath))

(define (get-area-name toppath configdat)
  ;; look up my area name in areas table (future)
  ;; generate auto name
  (conc (get-area-path-signature toppath)
	"-"
	(get-testsuite-name toppath configdat)))

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

)