Overview
Comment: | Added exit code check to [system ...] calls in config processing. Fixed xterm launching in dashboard |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
4722dc82a158e4a0ad03dfcf57d0abd0 |
User & Date: | mrwellan on 2011-06-13 22:16:50 |
Other Links: | manifest | tags |
Context
2011-06-14
| ||
23:04 | Added filters on test and items to dashboard. Not even close to having real scrolling but it'll have to do for now check-in: a76b6398d6 user: mrwellan tags: trunk | |
2011-06-13
| ||
22:16 | Added exit code check to [system ...] calls in config processing. Fixed xterm launching in dashboard check-in: 4722dc82a1 user: mrwellan tags: trunk | |
2011-06-07
| ||
00:48 | Added testname to popup edit window title check-in: ffaa4fa4b2 user: mrwellan tags: trunk | |
Changes
Modified Makefile from [65424085b1] to [882324e3f3].
1 2 3 4 5 | FILES=$(glob *.scm) megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process.scm runs.scm gui.scm csc megatest.scm | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | FILES=$(glob *.scm) megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process.scm runs.scm gui.scm csc megatest.scm dashboard: megatest dashboard.scm csc dashboard.scm $(PREFIX)/bin/megatest : megatest @echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change sleep 5 cp megatest $(PREFIX)/bin/megatest |
︙ | ︙ |
Modified configf.scm from [55fe90e96b] to [dcdd50d791].
︙ | ︙ | |||
51 52 53 54 55 56 57 | (comment-rx _ (loop (read-line inp) curr-section-name)) (blank-l-rx _ (loop (read-line inp) curr-section-name)) (include-rx ( x include-file ) (begin (read-config include-file res) (loop (read-line inp) curr-section-name))) (section-rx ( x section-name ) (loop (read-line inp) section-name)) (key-sys-pr ( x key cmd ) (let ((alist (hash-table-ref/default res curr-section-name '())) | | > > > > > > | | 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 | (comment-rx _ (loop (read-line inp) curr-section-name)) (blank-l-rx _ (loop (read-line inp) curr-section-name)) (include-rx ( x include-file ) (begin (read-config include-file res) (loop (read-line inp) curr-section-name))) (section-rx ( x section-name ) (loop (read-line inp) section-name)) (key-sys-pr ( x key cmd ) (let ((alist (hash-table-ref/default res curr-section-name '())) (val (let* ((cmdres (cmd-run->list cmd)) (status (cadr cmdres)) (res (car cmdres))) (if (not (eq? status 0)) (begin (print "ERROR: problem with " inl ", return code not 0") (exit 1))) (if (null? res) "" (string-intersperse res " "))))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key val)) ;; (append alist (list (list key val)))) (loop (read-line inp) curr-section-name))) (key-val-pr ( x key val ) (let ((alist (hash-table-ref/default res curr-section-name '()))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key val)) ;; (append alist (list (list key val)))) (loop (read-line inp) curr-section-name))) (else (print "ERROR: problem parsing " path ",\n \"" inl "\"") (loop (read-line inp) curr-section-name)))))))) (define (find-and-read-config fname) (let* ((curr-dir (current-directory)) (configinfo (find-config fname)) (toppath (car configinfo)) (configfile (cadr configinfo))) |
︙ | ︙ |
Modified dashboard.scm from [021a9fd27c] to [377ac3812f].
︙ | ︙ | |||
103 104 105 106 107 108 109 | (logfile (conc (db:test-get-rundir test) "/" (db:test-get-final_logf test))) (viewlog (lambda (x) (if (file-exists? logfile) (system (conc "firefox " logfile "&")) (message-window (conc "File " logfile " not found"))))) (xterm (lambda (x) (if (directory-exists? rundir) | > > > | > | 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | (logfile (conc (db:test-get-rundir test) "/" (db:test-get-final_logf test))) (viewlog (lambda (x) (if (file-exists? logfile) (system (conc "firefox " logfile "&")) (message-window (conc "File " logfile " not found"))))) (xterm (lambda (x) (if (directory-exists? rundir) (let ((shell (if (get-environment-variable "SHELL") (conc "-e " (get-environment-variable "SHELL")) ""))) (system (conc "cd " rundir ";xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&"))) (message-window (conc "Directory " rundir " not found"))))) (newstatus currstatus) (newstate currstate) (self #f)) ;; (test-set-status! db run-id test-name state status itemdat) (set! self |
︙ | ︙ |