blocking with-input-from-pipe pasted by klm` on Tue Jun 24 12:29:53 2014


(begin
  (print "begin " (current-milliseconds))
  (thread-start! (lambda () (print (with-input-from-pipe "sleep 5 ; echo foo" read-string))))
  (thread-yield!)
  (print "end " (current-milliseconds)))

workaround pasted by klm` on Tue Jun 24 13:07:03 2014



;;; this is stolen from http://bugs.call-cc.org/ticket/766


(define (open-input-file*/nonblock fd)
  (make-input-port
   (lambda ()
      (thread-wait-for-i/o! fd #:input)
      (let ((r (file-read fd 1)))
        (if (= 1 (cadr r)) ;; number of bytes read must = 1
            (string-ref (car r) 0)
            #!eof)))
    (lambda () (file-select fd #f 0))
    (lambda () (file-close fd))))

;; like open-output-file* but doesn't buffer anything.
(define (open-output-file*/nobuffer fd)
   (make-output-port (lambda (x) (file-write fd x))
                     (lambda ()  (file-close fd))))

;;; process* fix from Moritz (http://bugs.call-cc.org/ticket/766).
;;; non-blocking, line-buffered cli from a subprocess.
(define (spawn* cmd #!optional args env)
  (let*-values
      (((in-in   in-out) (create-pipe))
       ((out-in out-out) (create-pipe))
       ((pid) (process-fork
               (lambda ()
                 (duplicate-fileno in-in fileno/stdin)
                 (duplicate-fileno out-out fileno/stdout)
                 (file-close in-out)
                 (file-close in-in)
                 (file-close out-in)
                 (file-close out-out)
                 (process-execute cmd args env)))))

    (file-close in-in)
    (file-close out-out)

    (values (open-input-file*/nonblock  out-in)
            (open-output-file*/nobuffer in-out)
            pid)))





;; now this works:

(begin
  (print "begin " (current-milliseconds))

  (thread-start!
   (lambda ()
     (let-values (((pip pop pid) (spawn* "sh" '("-c" "sleep 1 ; echo foo"))))
       (print "output: "(read-string #f pip))
       (process-signal pid)
       (process-wait pid))))
  (thread-yield!)
  (print "end " (current-milliseconds)))

smaller workaround... pasted by C-Keen on Tue Jun 24 13:11:30 2014

(use posix srfi-18)
(print "begin " (current-milliseconds))
(thread-start! (lambda () (print (with-input-from-pipe "sleep 5 ; echo foo" (lambda ()
                                                                              (thread-wait-for-i/o! (current-input-port))
                                                                              (read-string (current-input-port)))))))
(thread-yield!)

(print "end " (current-milliseconds))

fix for smaller workaround pasted by klm` on Tue Jun 24 13:15:58 2014

                                                                              I think you need to change to this:

(thread-wait-for-i/o! (port->fileno (current-input-port)))

fix for the fix for the workaround (what goes around works around) pasted by C-Keen on Tue Jun 24 13:19:14 2014

(use posix srfi-18)
(print "begin " (current-milliseconds))
(thread-start! (lambda () (print (with-input-from-pipe "sleep 5 ; echo foo" (lambda ()
                                                                              (thread-wait-for-i/o! (port->fileno (current-input-port)))
                                                                              (read-string #f (current-input-port)))))))
(thread-yield!)

(print "end " (current-milliseconds))

snippet to easily show if srfi-18 threads are blocked pasted by klm` on Tue Jun 24 13:22:31 2014


;; just in case anyone might find this useful.
;; this will make an hysteric REPL that continuously updates itself, 
;; without flooding your terminal or emacs csi-session

;; (thread-terminate! thread)
(define thread
  (thread-start!
   (lambda () (let loop ()
           (print* "\r" (current-milliseconds) " ")
           (thread-sleep! 0.111)
           (loop)))))

;; if it stops, something is blocking you!

a better workaround added by klm` on Mon Sep 22 13:42:56 2014


;; the previous workarounds won't block while waiting for the first byte, but will block other srfi-18 threads after that. let's make a new port which never blocks instead!


;; don't block while reading anything from port p. port p must have an
;; associated filedescriptor.
(define (make-nonblocking-input-port p)
  (make-input-port (lambda ()
                     (thread-wait-for-i/o! (port->fileno p))
                     (read-char p))
                   (lambda () (char-ready? p))
                   (lambda () (close-input-port p))))


(begin
  (print "begin " (current-milliseconds))
  (thread-start!
   (lambda ()
     (pp 
      (call-with-input-pipe
       "sleep 1;  echo a ; sleep 1 ; echo b"
       (o (lambda (p) (read-string #f p)) make-nonblocking-input-port)))))
  (thread-yield!)

  (print "end " (current-milliseconds)))