diff options
| -rw-r--r-- | scsh-process.egg | 11 | ||||
| -rw-r--r-- | scsh-process.meta | 6 | ||||
| -rw-r--r-- | scsh-process.scm | 29 | ||||
| -rw-r--r-- | tests/run.scm | 37 |
4 files changed, 62 insertions, 21 deletions
diff --git a/scsh-process.egg b/scsh-process.egg new file mode 100644 index 0000000..3189b27 --- /dev/null +++ b/scsh-process.egg @@ -0,0 +1,11 @@ +;;; scsh-process.egg -*- Scheme -*- + +((synopsis "A reimplementation for CHICKEN of SCSH's process notation.") + (author "Peter Bex") + (category os) + (license "BSD") + (dependencies srfi-18 srfi-69) + (test-dependencies test) + (components + (extension scsh-process + (csc-options "-O3" "-feature" "has-thread-killer")))) diff --git a/scsh-process.meta b/scsh-process.meta index 73a61b6..0bda257 100644 --- a/scsh-process.meta +++ b/scsh-process.meta @@ -1,10 +1,8 @@ ;;; scsh-process.meta -*- Scheme -*- -((synopsis "") +((synopsis "A reimplementation for CHICKEN of SCSH's process notation.") (author "Peter Bex") (category os) (license "BSD") - (doc-from-wiki) ;(depends) - (test-depends test) - (files "scsh-process.meta" "scsh-process.release-info" "scsh-process.scm" "scsh-process.setup" "tests/run.scm")) + (test-depends test)) diff --git a/scsh-process.scm b/scsh-process.scm index f675a2c..596a6b5 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -52,9 +52,17 @@ process? proc:pid proc? wait signal-process process-sleep) -(import chicken scheme data-structures) - -(use extras utils files ports posix srfi-1 srfi-18 srfi-69) +(import scheme) + +(cond-expand + (chicken-5 (import (chicken base) (chicken condition) (chicken io) + (chicken port) (chicken file) (chicken file posix) + (chicken string) + (chicken process) (chicken process signal) + srfi-18 srfi-69)) + (else (import chicken) + (use data-structures (rename extras (read-file read-list)) + utils files ports posix srfi-1 srfi-18 srfi-69))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; Process bookkeeping ;; @@ -272,8 +280,11 @@ (define (fork/pipe+ conns #!optional thunk continue-threads?) ;; Blergh, this is silly overhead we don't really need - (let* ((from-fds (map (lambda (x) (drop-right x 1)) conns)) - (to-fds (map last conns)) + (let* ((revconns (map reverse conns)) + ;; from-fds is everything but the last, to-fds the last of + ;; each connection spec. + (from-fds (map (lambda (x) (reverse (cdr x))) revconns)) + (to-fds (map car revconns)) (pipe-pairs (map (lambda _ (receive (create-pipe))) to-fds)) (proc (fork #f continue-threads?))) (if (not proc) ; Child @@ -356,13 +367,17 @@ (lambda () (close-input-port in))))) (define (run/string* thunk) - (call-with-run/port* thunk (lambda (in) (read-string #f in)))) + (call-with-run/port* thunk (lambda (in) + (let ((result (read-string #f in))) + (if (eof-object? result) + "" + result))))) (define (run/strings* thunk) (call-with-run/port* thunk read-lines)) (define (run/sexp* thunk) (call-with-run/port* thunk read)) (define (run/sexps* thunk) - (call-with-run/port* thunk read-file)) + (call-with-run/port* thunk read-list)) ;;;;;;;;;;;; ;; Syntax ;; diff --git a/tests/run.scm b/tests/run.scm index 98b6c25..c4ab584 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -1,12 +1,27 @@ (module scsh-tests () -(import chicken scheme) - -#;(include "../scsh-process.scm") -(use scsh-process) - -(use test utils extras ports files posix - srfi-13 srfi-18 (only setup-api version>=?)) +(import scheme) + +(cond-expand + (chicken-5 (import (chicken base) (chicken port) (chicken condition) + (chicken io) (chicken file) (chicken file posix) + (chicken process signal) + (chicken fixnum) ;; Why is this needed?! + srfi-18 test) + #;(include "../scsh-process.scm") + (import scsh-process) + + (define (read-all #!optional file-or-port) + (cond ((string? file-or-port) + (with-input-from-file file-or-port read-string)) + (file-or-port (read-string #f file-or-port)) + (else (read-string)))) + ) + (else (import chicken) + #;(include "../scsh-process.scm") + (use scsh-process) + (use test utils extras ports files posix + srfi-13 srfi-18 (only setup-api version>=?)))) (test-begin "scsh-process") @@ -116,11 +131,11 @@ (test "Appending to a file" '("blah" "foo") (begin (run (echo foo) (>> ,tmpfile)) - (read-lines tmpfile))) + (with-input-from-file tmpfile read-lines))) (let ((message "testing, 1 2 3")) (test "Redirecting from object" - `("blah" "foo" ,(string-delete #\t message)) + `("blah" "foo" ,"esing, 1 2 3") (run/strings (pipe (epf (tr -d t) (<< ,message)) (cat ,tmpfile -))))) (delete-file* tmpfile))) @@ -129,7 +144,9 @@ (test "run/string with begin form" "hi, there\n" (run/string (pipe (begin (print "hi, there")) (cat)))) - (when (version>=? (chicken-version) "4.8.1") + (when (cond-expand + (chicken-5 #t) + (else (version>=? (chicken-version) "4.8.1"))) (let ((child? #f)) (thread-start! (lambda () (thread-sleep! 0.5) |