Overview
Comment: | Added stderr capture on launch |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | test4-clean-fast | stderr-capture |
Files: | files | file ages | folders |
SHA1: |
a7d93e42e405fd489a1e742f0104e43f |
User & Date: | matt on 2012-10-08 22:58:25 |
Other Links: | branch diff | manifest | tags |
Context
2012-10-08
| ||
23:12 | Merged in feature branch stderr-capture (works ok) check-in: 8ee92f3656 user: matt tags: trunk | |
22:58 | Added stderr capture on launch Closed-Leaf check-in: a7d93e42e4 user: matt tags: test4-clean-fast, stderr-capture | |
22:44 | Merged b2448 into trunk, passes test4 check-in: 2d26c7fb2e user: matt tags: trunk, test4-clean | |
11:38 | Added logging to an sqlite3 db, updated installall.sh to latest chicken and iup releases, proper capture of stderr on launch process. check-in: 69482225b7 user: mrwellan tags: rpc-db-access, these-changes-moved-to-logging-to-db-branch | |
Changes
Modified launch.scm from [0714961a30] to [dc96227333].
︙ | ︙ | |||
603 604 605 606 607 608 609 | (append (list (list "MT_TEST_RUN_DIR" work-area) (list "MT_TEST_NAME" test-name) (list "MT_ITEM_INFO" (conc itemdat)) (list "MT_RUNNAME" runname) (list "MT_TARGET" mt_target) ) itemdat))) | | | | 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 | (append (list (list "MT_TEST_RUN_DIR" work-area) (list "MT_TEST_NAME" test-name) (list "MT_ITEM_INFO" (conc itemdat)) (list "MT_RUNNAME" runname) (list "MT_TARGET" mt_target) ) itemdat))) (launch-results (apply cmd-run-with-stderr->list ;; cmd-run-proc-each-line (if useshell (string-intersperse fullcmd " ") (car fullcmd)) ;; conc (if useshell '() (cdr fullcmd))))) ;; launcher fullcmd)));; (apply cmd-run-proc-each-line launcher print fullcmd))) ;; (cmd-run->list fullcmd)) (with-output-to-file "mt_launch.log" (lambda () (apply print launch-results))) (debug:print 2 "Launching completed, updating db") |
︙ | ︙ |
Modified process.scm from [71a058a91c] to [444a7f5a5f].
︙ | ︙ | |||
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | ;;====================================================================== ;; Process convience utils ;;====================================================================== (declare (unit process)) (declare (uses common)) (define (cmd-run-proc-each-line cmd proc . params) ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params) (handle-exceptions exn (begin (print "ERROR: Failed to run command: " cmd " " (string-intersperse params " ")) #f) (let-values (((fh fho pid) (if (null? params) (process cmd) (process cmd params)))) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | 11 12 13 14 15 16 17 18 19 20 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 | ;;====================================================================== ;; Process convience utils ;;====================================================================== (declare (unit process)) (declare (uses common)) (define (conservative-read port) (let loop ((res "")) (if (not (eof-object? (peek-char port))) (loop (conc res (read-char port))) res))) (define (cmd-run-with-stderr->list cmd . params) ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params) ;; (handle-exceptions ;; exn ;; (begin ;; (print "ERROR: Failed to run command: " cmd " " (string-intersperse params " ")) ;; (print " " ((condition-property-accessor 'exn 'message) exn)) ;; #f) (let-values (((fh fho pid fhe) (if (null? params) (process* cmd) (process* cmd params)))) (let loop ((curr (read-line fh)) (result '())) (let ((errstr (conservative-read fhe))) (if (not (string=? errstr "")) (set! result (append result (list errstr))))) (if (not (eof-object? curr)) (loop (read-line fh) (append result (list curr))) (begin (close-input-port fh) (close-input-port fhe) (close-output-port fho) result))))) ;; ) (define (cmd-run-proc-each-line cmd proc . params) ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params) (handle-exceptions exn (begin (print "ERROR: Failed to run command: " cmd " " (string-intersperse params " ")) #f) (let-values (((fh fho pid) (if (null? params) (process cmd) (process cmd params)))) (let loop ((curr (read-line fh)) (result '())) (if (not (eof-object? curr)) (loop (read-line fh) (append result (list (proc curr)))) (begin (close-input-port fh) (close-input-port fhe) (close-output-port fho) result)))))) (define (cmd-run-proc-each-line-alt cmd proc) (let* ((fh (open-input-pipe cmd)) (res (port-proc->list fh proc)) (status (close-input-pipe fh))) |
︙ | ︙ |
Modified tests/tests.scm from [69324af198] to [6debbc62bb].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | (require-extension test) (define test-work-dir (current-directory)) ;; read in all the _record files (let ((files (glob "*_records.scm"))) (for-each (lambda (file) (print "Loading " file) (load file)) files)) (define conffile #f) (test "Read a config" #t (hash-table? (read-config "test.config" #f #f))) (test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f))) (set! conffile (read-config "test.config" #f #f)) (test "Get available diskspace" #t (number? (get-df "./"))) | > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | (require-extension test) (require-extension regex) (define test-work-dir (current-directory)) ;; read in all the _record files (let ((files (glob "*_records.scm"))) (for-each (lambda (file) (print "Loading " file) (load file)) files)) ;;====================================================================== ;; P R O C E S S E S ;;====================================================================== (test "cmd-run-with-stderr->list" '("No such file or directory") (let ((reslst (cmd-run-with-stderr->list "ls" "/tmp/ihadbetternotexist"))) (string-search (regexp "No such file or directory")(car reslst)))) ;;====================================================================== ;; C O N F I G F I L E S ;;====================================================================== (define conffile #f) (test "Read a config" #t (hash-table? (read-config "test.config" #f #f))) (test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f))) (set! conffile (read-config "test.config" #f #f)) (test "Get available diskspace" #t (number? (get-df "./"))) |
︙ | ︙ |