Overview
Comment: | Added more needed functions to commonmod in prep for multi-area support in newview |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-newview |
Files: | files | file ages | folders |
SHA1: |
ccab6e04aff4406711aecbfa9b41ea0a |
User & Date: | matt on 2020-04-13 06:05:02 |
Other Links: | branch diff | manifest | tags |
Context
2020-04-14
| ||
10:33 | Updated TODO check-in: c7977972a1 user: mrwellan tags: v1.65-newview | |
2020-04-13
| ||
06:05 | Added more needed functions to commonmod in prep for multi-area support in newview check-in: ccab6e04af user: matt tags: v1.65-newview | |
2020-04-12
| ||
23:51 | Added auto gen area name check-in: eeb358089d user: matt tags: v1.65-newview | |
Changes
Modified common.scm from [ab4de5a0a9] to [17bee313ac].
︙ | ︙ | |||
1611 1612 1613 1614 1615 1616 1617 | (if (> curr-rownum rownum) curr-rownum rownum) (if (> curr-colnum colnum) curr-colnum colnum) )))))) ;; if it looks like a number -> convert it to a number, else return it ;; (define (common:lazy-convert inval) | < | < < < < < < < < | < < < | 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 | (if (> curr-rownum rownum) curr-rownum rownum) (if (> curr-colnum colnum) curr-colnum colnum) )))))) ;; if it looks like a number -> convert it to a number, else return it ;; (define (common:lazy-convert inval) (cmod:lazy-convert inval)) ;; convert string a=1; b=2; c=a silly thing; d= ;; to '((a . 1)(b . 2)(c . "a silly thing")(d . "")) ;; (define (common:val->alist val #!key (convert #f)) (cmod:val->alist val #!key (convert #f))) ;;====================================================================== ;; S Y S T E M S T U F F ;;====================================================================== ;; lazy-safe get file mod time. on any error (file not existing etc.) return 0 ;; |
︙ | ︙ |
Modified commonmod.scm from [f09504d905] to [3a4a140a66].
︙ | ︙ | |||
21 22 23 24 25 26 27 | (declare (unit commonmod)) (module commonmod * (import scheme chicken data-structures extras files) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 | | > > > > > > | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > | | > > > > > > > > > > > > > > > > > > > > > > > | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | (declare (unit commonmod)) (module commonmod * (import scheme chicken data-structures extras files) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 md5 message-digest regex srfi-1) ;;====================================================================== ;; CONTENTS ;; ;; config file utils ;; misc conversion, data manipulation functions ;; testsuite and area utilites ;; ;;====================================================================== ;;====================================================================== ;; 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)) |
︙ | ︙ |