From dd7d5a27716ca0c02314487711f6a9cb32731440 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Thu, 16 Aug 2018 22:41:12 +0200
Subject: Port scsh-process to CHICKEN 5

Thanks to Vasilij Schneidermann for providing an initial patch.
---
 scsh-process.egg  | 11 +++++++++++
 scsh-process.meta |  6 ++----
 scsh-process.scm  | 29 ++++++++++++++++++++++-------
 tests/run.scm     | 37 +++++++++++++++++++++++++++----------
 4 files changed, 62 insertions(+), 21 deletions(-)
 create mode 100644 scsh-process.egg

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)
-- 
cgit v1.2.3