Megatest

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

)