Welcome to the CHICKEN Scheme pasting service
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)))