Artifact 1140c67c4203134a666d323e21b3feef222dcc22:
- File runconfig.scm — part of check-in [6654e3905e] at 2011-07-19 00:08:45 on branch trunk — Added support for tags to megatest. Dashboard not done yet (user: matt size: 1591)
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;============== 0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 72 65 61 64 ========.;; read 0050: 20 61 20 63 6f 6e 66 69 67 20 66 69 6c 65 2c 20 a config file, 0060: 6c 6f 61 64 69 6e 67 20 6f 6e 6c 79 20 74 68 65 loading only the 0070: 20 73 65 63 74 69 6f 6e 20 70 65 72 74 69 6e 65 section pertine 0080: 6e 74 0a 3b 3b 20 74 6f 20 74 68 69 73 20 72 75 nt.;; to this ru 0090: 6e 20 66 69 65 6c 64 31 76 61 6c 2f 66 69 65 6c n field1val/fiel 00a0: 64 32 76 61 6c 2f 66 69 65 6c 64 33 76 61 6c 20 d2val/field3val 00b0: 2e 2e 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ....;;========== 00c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 00d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 00e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 00f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 ============.(de 0100: 66 69 6e 65 20 28 73 65 74 75 70 2d 65 6e 76 2d fine (setup-env- 0110: 64 65 66 61 75 6c 74 73 20 64 62 20 66 6e 61 6d defaults db fnam 0120: 65 20 72 75 6e 2d 69 64 20 2e 20 61 6c 72 65 61 e run-id . alrea 0130: 64 79 2d 73 65 65 6e 29 0a 20 20 28 6c 65 74 2a dy-seen). (let* 0140: 20 28 28 6b 65 79 73 20 20 20 20 28 67 65 74 2d ((keys (get- 0150: 6b 65 79 73 20 64 62 29 29 0a 09 20 28 6b 65 79 keys db)).. (key 0160: 76 61 6c 73 20 28 67 65 74 2d 6b 65 79 2d 76 61 vals (get-key-va 0170: 6c 73 20 64 62 20 72 75 6e 2d 69 64 29 29 0a 09 ls db run-id)).. 0180: 20 28 74 68 65 6b 65 79 20 20 28 73 74 72 69 6e (thekey (strin 0190: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m 01a0: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 69 ap (lambda (x)(i 01b0: 66 20 78 20 78 20 22 2d 6e 61 2d 22 29 29 20 6b f x x "-na-")) k 01c0: 65 79 76 61 6c 73 29 20 22 2f 22 29 29 0a 09 20 eyvals) "/")).. 01d0: 28 63 6f 6e 66 64 61 74 20 28 72 65 61 64 2d 63 (confdat (read-c 01e0: 6f 6e 66 69 67 20 66 6e 61 6d 65 29 29 0a 09 20 onfig fname)).. 01f0: 28 77 68 61 74 66 6f 75 6e 64 20 28 6d 61 6b 65 (whatfound (make 0200: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table)).. 0210: 28 73 65 63 74 69 6f 6e 73 20 28 6c 69 73 74 20 (sections (list 0220: 22 64 65 66 61 75 6c 74 22 20 74 68 65 6b 65 79 "default" thekey 0230: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p 0240: 72 69 6e 74 20 34 20 22 55 73 69 6e 67 20 6b 65 rint 4 "Using ke 0250: 79 3d 5c 22 22 20 74 68 65 6b 65 79 20 22 5c 22 y=\"" thekey "\" 0260: 22 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 "). (for-each 0270: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda ( 0280: 73 65 63 74 69 6f 6e 29 0a 20 20 20 20 20 20 20 section). 0290: 28 6c 65 74 20 28 28 73 65 63 74 69 6f 6e 2d 64 (let ((section-d 02a0: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r 02b0: 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 64 ef/default confd 02c0: 61 74 20 73 65 63 74 69 6f 6e 20 23 66 29 29 29 at section #f))) 02d0: 0a 09 20 28 69 66 20 73 65 63 74 69 6f 6e 2d 64 .. (if section-d 02e0: 61 74 0a 09 20 20 20 20 20 28 66 6f 72 2d 65 61 at.. (for-ea 02f0: 63 68 20 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 ch .. (lamb 0300: 64 61 20 28 65 6e 76 76 61 72 29 0a 09 09 28 68 da (envvar)...(h 0310: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 77 ash-table-set! w 0320: 68 61 74 66 6f 75 6e 64 20 73 65 63 74 69 6f 6e hatfound section 0330: 20 28 2b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (+ (hash-table- 0340: 72 65 66 2f 64 65 66 61 75 6c 74 20 77 68 61 74 ref/default what 0350: 66 6f 75 6e 64 20 73 65 63 74 69 6f 6e 20 30 29 found section 0) 0360: 20 31 29 29 0a 09 09 28 73 65 74 65 6e 76 20 65 1))...(setenv e 0370: 6e 76 76 61 72 20 28 63 61 64 72 20 28 61 73 73 nvvar (cadr (ass 0380: 6f 63 20 65 6e 76 76 61 72 20 73 65 63 74 69 6f oc envvar sectio 0390: 6e 2d 64 61 74 29 29 29 29 0a 09 20 20 20 20 20 n-dat)))).. 03a0: 20 28 6d 61 70 20 63 61 72 20 73 65 63 74 69 6f (map car sectio 03b0: 6e 2d 64 61 74 29 29 29 29 29 0a 20 20 20 20 20 n-dat))))). 03c0: 73 65 63 74 69 6f 6e 73 29 0a 20 20 20 20 28 69 sections). (i 03d0: 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 6c f (and (not (nul 03e0: 6c 3f 20 61 6c 72 65 61 64 79 2d 73 65 65 6e 29 l? already-seen) 03f0: 29 0a 09 20 20 20 20 20 28 6e 6f 74 20 28 63 61 ).. (not (ca 0400: 72 20 61 6c 72 65 61 64 79 2d 73 65 65 6e 29 29 r already-seen)) 0410: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 )..(begin.. (de 0420: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4b 65 79 bug:print 2 "Key 0430: 20 73 65 74 74 69 6e 67 73 20 66 6f 75 6e 64 20 settings found 0440: 69 6e 20 72 75 6e 63 6f 6e 66 69 67 2e 63 6f 6e in runconfig.con 0450: 66 69 67 3a 22 29 0a 09 20 20 28 66 6f 72 2d 65 fig:").. (for-e 0460: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 66 75 6c ach (lambda (ful 0470: 6c 6b 65 79 29 0a 09 09 20 20 20 20 20 20 28 64 lkey)... (d 0480: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 28 66 6f ebug:print 2 (fo 0490: 72 6d 61 74 20 23 66 20 22 7e 32 30 61 20 7e 61 rmat #f "~20a ~a 04a0: 5c 6e 22 20 66 75 6c 6c 6b 65 79 20 28 68 61 73 \n" fullkey (has 04b0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa 04c0: 75 6c 74 20 77 68 61 74 66 6f 75 6e 64 20 66 75 ult whatfound fu 04d0: 6c 6c 6b 65 79 20 30 29 29 29 29 0a 09 09 20 20 llkey 0))))... 04e0: 20 20 73 65 63 74 69 6f 6e 73 29 0a 09 20 20 28 sections).. ( 04f0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 2d debug:print 2 "- 0500: 2d 2d 22 29 0a 09 20 20 28 73 65 74 21 20 2a 61 --").. (set! *a 0510: 6c 72 65 61 64 79 2d 73 65 65 6e 2d 72 75 6e 63 lready-seen-runc 0520: 6f 6e 66 69 67 2d 69 6e 66 6f 2a 20 23 74 29 29 onfig-info* #t)) 0530: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 )))..(define (se 0540: 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 t-run-config-var 0550: 73 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 s db run-id). ( 0560: 6c 65 74 20 28 28 72 75 6e 63 6f 6e 66 69 67 66 let ((runconfigf 0570: 20 28 63 6f 6e 63 20 20 2a 74 6f 70 70 61 74 68 (conc *toppath 0580: 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 * "/runconfigs.c 0590: 6f 6e 66 69 67 22 29 29 29 0a 20 20 20 20 28 69 onfig"))). (i 05a0: 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 f (file-exists? 05b0: 72 75 6e 63 6f 6e 66 69 67 66 29 0a 09 28 73 65 runconfigf)..(se 05c0: 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 6c 74 73 tup-env-defaults 05d0: 20 64 62 20 72 75 6e 63 6f 6e 66 69 67 66 20 72 db runconfigf r 05e0: 75 6e 2d 69 64 29 0a 09 28 64 65 62 75 67 3a 70 un-id)..(debug:p 05f0: 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a rint 0 "WARNING: 0600: 20 59 6f 75 20 64 6f 20 6e 6f 74 20 68 61 76 65 You do not have 0610: 20 61 20 72 75 6e 20 63 6f 6e 66 69 67 20 66 69 a run config fi 0620: 6c 65 3a 20 22 20 72 75 6e 63 6f 6e 66 69 67 66 le: " runconfigf 0630: 29 29 29 29 0a 20 20 )))).