;;======================================================================
;; Copyright 2017, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; 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))
)