1: ;;
    2: ;; test gauche.process
    3: ;;
    4: 
    5: (use gauche.test)
    6: (use srfi-13)
    7: (test-start "gauche.process")
    8: 
    9: (use gauche.process)
   10: (test-module 'gauche.process)
   11: 
   12: ;; Check if the programs we'll use are available on the
   13: ;; platform.  If not, we don't do further test.
   14: (unless (and (zero? (sys-system "cat /dev/null"))
   15:              (zero? (sys-system "ls > /dev/null"))
   16:              (zero? (sys-system "echo x | grep x > /dev/null")))
   17:   (test-end)
   18:   (exit 0))
   19: 
   20: ;; Avoid locale specific behavior of client programs
   21: (when (global-variable-bound? 'gauche 'sys-putenv)
   22:   (sys-putenv "LANG" "C"))
   23: 
   24: ;;-------------------------------
   25: (test-section "process object")
   26: 
   27: (sys-system "rm -rf test.o test1.o")
   28: (sys-system "touch test.o")
   29: 
   30: (test* "run-process (old)" 0
   31:        (let1 p (run-process 'ls :output "test.o")
   32:          (and (process-wait p) (process-exit-status p))))
   33: (test* "run-process" 0
   34:        (let1 p (run-process '(ls) :output "test.o")
   35:          (and (process-wait p) (process-exit-status p))))
   36: (test* "run-process (old)" 0
   37:        (let1 p (run-process 'grep "test.o" :input "test.o" :output "/dev/null")
   38:          (and (process-wait p) (process-exit-status p))))
   39: (test* "run-process" 0
   40:        (let1 p (run-process '(grep "test.o") :input "test.o" :output "/dev/null")
   41:          (and (process-wait p) (process-exit-status p))))
   42: (test* "run-process (old)" 256
   43:        (let1 p (run-process 'grep "NoSuchFile"
   44:                             :input "test.o" :output "/dev/null")
   45:          (and (process-wait p) (process-exit-status p))))
   46: (test* "run-process" 256
   47:        (let1 p (run-process '(grep "NoSuchFile")
   48:                             :input "test.o" :output "/dev/null")
   49:          (and (process-wait p) (process-exit-status p))))
   50: 
   51: (test* "run-process (output pipe)" '(0 #t)
   52:        (let* ((p  (run-process '("cat" "test.o") :output :pipe))
   53:               (in (process-output p))
   54:               (s  (port->string in))
   55:               (c  (call-with-input-file "test.o" port->string))
   56:               (x  (and (process-wait p) (process-exit-status p))))
   57:          (list x (equal? c s))))
   58: 
   59: (test* "run-process (input pipe)" '(0 #t)
   60:        (let* ((p  (run-process '("cat") :input :pipe :output :pipe))
   61:               (out (process-input p))
   62:               (in  (process-output p))
   63:               (s   "test\ntest"))
   64:          (display s out)
   65:          (close-output-port out)
   66:          (let* ((ss (port->string in))
   67:                 (x  (and (process-wait p) (process-exit-status p))))
   68:            (list x (equal? s ss)))))
   69: 
   70: (test* "run-process (error pipe)" #t
   71:        (let* ((p  (run-process '("cat" "NoSuchFile") :error :pipe))
   72:               (in (process-error p))
   73:               (s  (port->string in))
   74:               (x  (process-wait p))
   75:               (p1 (run-process '("cat" "NoSuchFile") :error "test.o"))
   76:               (s1 (and (process-wait p1)
   77:                        (call-with-input-file "test.o" port->string)))
   78:               )
   79:          (equal? s s1)))
   80: 
   81: ;; NB: how to test :wait and :fork?
   82: 
   83: (test* "process-kill" SIGKILL
   84:        (let ((p (run-process '("cat")
   85:                              :input :pipe :output :pipe
   86:                              :error "/dev/null")))
   87:          (process-kill p)
   88:          (process-wait p)
   89:          (let ((x (process-exit-status p)))
   90:            (and (sys-wait-signaled? x)
   91:                 (sys-wait-termsig x)))))
   92: 
   93: (test* "non-blocking wait" '(#f #t #f)
   94:        (let* ((p  (run-process '("cat")
   95:                                :input :pipe :output :pipe
   96:                                :error "/dev/null"))
   97:               (r0 (process-wait p #t))
   98:               (r1 (begin (process-kill p) (process-wait p)))
   99:               (r2 (process-wait p #t))
  100:               )
  101:          (list r0 r1 r2)))
  102: 
  103: (test* "wait with signalling error" (list #t SIGKILL)
  104:        (guard (e ((<process-abnormal-exit> e)
  105:                   (let ((s (process-exit-status (ref e 'process))))
  106:                     (list (sys-wait-signaled? s)
  107:                           (sys-wait-termsig s)))))
  108:          (let1 p (run-process '("cat")
  109:                               :input :pipe :output :pipe
  110:                               :error "/dev/null")
  111:            (process-kill p)
  112:            (process-wait p #f #t))))
  113: 
  114: (test* "process-list" '()
  115:        (process-list))
  116: 
  117: ;;-------------------------------
  118: (test-section "process ports")
  119: 
  120: (sys-system "rm -rf test.o test1.o test2.o")
  121: (sys-system "touch test.o")
  122: (sys-system "ls -a > test.o")
  123: 
  124: (test* "open-input-process-port" #t
  125:        (receive (p process) (open-input-process-port '(ls -a))
  126:          (let ((r (port->string p))
  127:                (s (call-with-input-file "test.o" port->string)))
  128:            (close-input-port p)
  129:            (process-wait process)
  130:            (equal? r s))))
  131: 
  132: (test* "open-input-process-port (redirect)" #t
  133:        (receive (p process) (open-input-process-port '(cat) :input "test.o")
  134:          (let ((r (port->string p))
  135:                (s (call-with-input-file "test.o" port->string)))
  136:            (close-input-port p)
  137:            (process-wait process)
  138:            (equal? r s))))
  139: 
  140: (test* "open-input-process-port (redirect/error)" #t
  141:        (receive (p process) (open-input-process-port '(cat "NoSuchFile")
  142:                                                      :error "test1.o")
  143:          (process-wait process)
  144:          (sys-system "cat NoSuchFile 2> test2.o")
  145:          (let ((r (call-with-input-file "test1.o" port->string))
  146:                (s (call-with-input-file "test2.o" port->string)))
  147:            (equal? r s))))
  148: 
  149: (sys-system "rm -f test1.o test2.o")
  150: 
  151: (test* "call-with-input-process" #t
  152:        (let ((r (call-with-input-process '(ls -a) port->string))
  153:              (s (call-with-input-file "test.o" port->string)))
  154:          (equal? r s)))
  155: 
  156: (test* "call-with-input-process" #t
  157:        (let ((r (call-with-input-process "ls -a" port->string))
  158:              (s (call-with-input-file "test.o" port->string)))
  159:          (equal? r s)))
  160: 
  161: (test* "call-with-input-process (redirect)" #t
  162:        (let ((r (call-with-input-process '(cat) port->string :input "test.o"))
  163:              (s (call-with-input-file "test.o" port->string)))
  164:          (equal? r s)))
  165: 
  166: (test* "call-with-input-process (redirect/error - ignore)" #t
  167:        (begin (call-with-input-process "cat NoSuchFile"
  168:                 port->string
  169:                 :error "test1.o" :on-abnormal-exit :ignore)
  170:               (sys-system "cat NoSuchFile 2> test2.o")
  171:               (let ((r (call-with-input-file "test1.o" port->string))
  172:                     (s (call-with-input-file "test2.o" port->string)))
  173:                 (equal? r s))))
  174: 
  175: (test* "call-with-input-process (redirect/error - error)" #t
  176:        (guard (e ((<process-abnormal-exit> e)
  177:                   (sys-system "cat NoSuchFile 2> test2.o")
  178:                   (let ((r (call-with-input-file "test1.o" port->string))
  179:                         (s (call-with-input-file "test2.o" port->string)))
  180:                     (equal? r s))))
  181:          (call-with-input-process "cat NoSuchFile"
  182:            port->string :error "test1.o")))
  183: 
  184: (test* "call-with-input-process (redirect/error - handle)" 1
  185:        (let/cc k
  186:          (call-with-input-process '(cat NoSuchFile)
  187:            port->string
  188:            :error "test1.o"
  189:            :on-abnormal-exit (lambda (p)
  190:                                (k (sys-wait-exit-status
  191:                                    (process-exit-status p)))))))
  192: 
  193: (sys-system "rm -f test1.o test2.o")
  194: 
  195: (test* "with-input-from-process" #t
  196:        (let ((r (with-input-from-process '(cat test.o)
  197:                   (lambda () (port->string (current-input-port)))))
  198:              (s (call-with-input-file "test.o" port->string)))
  199:          (equal? r s)))
  200: 
  201: (test* "with-input-from-process" #t
  202:        (let ((r (with-input-from-process "cat < test.o"
  203:                   (lambda () (port->string (current-input-port)))))
  204:              (s (call-with-input-file "test.o" port->string)))
  205:          (equal? r s)))
  206: 
  207: (test* "with-input-from-process (redirect)" #t
  208:        (let ((r (with-input-from-process '(cat test.o)
  209:                   (lambda () (port->string (current-input-port)))
  210:                   :input "test.o"))
  211:              (s (call-with-input-file "test.o" port->string)))
  212:          (equal? r s)))
  213: 
  214: (test* "open-output-process-port" #t
  215:        (let1 s (call-with-input-file "test.o" port->string)
  216:          (sys-system "rm -f test.o")
  217:          (receive (p process) (open-output-process-port "cat > test.o")
  218:            (display s p)
  219:            (close-output-port p)
  220:            (process-wait process)
  221:            (let1 r (call-with-input-file "test.o" port->string)
  222:              (equal? r s)))))
  223: 
  224: (test* "open-output-process-port (redirect)" #t
  225:        (let1 s (call-with-input-file "test.o" port->string)
  226:          (sys-system "rm -f test.o")
  227:          (receive (p process)
  228:              (open-output-process-port '(cat) :output "test.o")
  229:            (display s p)
  230:            (close-output-port p)
  231:            (process-wait process)
  232:            (let1 r (call-with-input-file "test.o" port->string)
  233:              (equal? r s)))))
  234: 
  235: (test* "open-output-process-port (redirect/error)" #t
  236:        (let1 s (call-with-input-file "test.o" port->string)
  237:          (receive (p process)
  238:              (open-output-process-port "cat NoSuchFile" :error "test1.o")
  239:            (process-wait process)
  240:            (sys-system "cat NoSuchFile 2> test2.o")
  241:            (let ((r (call-with-input-file "test1.o" port->string))
  242:                  (s (call-with-input-file "test2.o" port->string)))
  243:              (equal? r s)))))
  244: 
  245: (sys-system "rm -f test1.o test2.o")
  246: 
  247: (test* "call-with-output-process" '(#t 1 2)
  248:        (let1 s (call-with-input-file "test.o" port->string)
  249:          (sys-system "rm -f test.o")
  250:          (receive (x y)
  251:              (call-with-output-process "cat > test.o"
  252:                (lambda (out) (display s out) (values 1 2)))
  253:            (let1 r (call-with-input-file "test.o" port->string)
  254:              (list (equal? r s) x y)))))
  255: 
  256: (test* "call-with-output-process (redirect)" '(#t 1 2)
  257:        (let1 s (call-with-input-file "test.o" port->string)
  258:          (sys-system "rm -f test.o")
  259:          (receive (x y)
  260:              (call-with-output-process '(cat)
  261:                (lambda (out) (display s out) (values 1 2))
  262:                :output "test.o")
  263:            (let1 r (call-with-input-file "test.o" port->string)
  264:              (list (equal? r s) x y)))))
  265:        
  266: (test* "call-with-output-process (redirect/error - ignore)" #t
  267:        (begin
  268:          (call-with-output-process "cat NoSuchFile"
  269:            (lambda (out) #f)
  270:            :error "test1.o" :on-abnormal-exit :ignore)
  271:          (sys-system "cat NoSuchFile 2> test2.o")
  272:          (let ((r (call-with-input-file "test1.o" port->string))
  273:                (s (call-with-input-file "test2.o" port->string)))
  274:            (equal? r s))))
  275: 
  276: (test* "call-with-output-process (redirect/error - raise)" #t
  277:        (guard (e ((<process-abnormal-exit> e)
  278:                   (sys-system "cat NoSuchFile 2> test2.o")
  279:                   (let ((r (call-with-input-file "test1.o" port->string))
  280:                         (s (call-with-input-file "test2.o" port->string)))
  281:                     (equal? r s))))
  282:          (call-with-output-process "cat NoSuchFile"
  283:            (lambda (out) #f) :error "test1.o")))
  284: 
  285: (test* "call-with-input-process (redirect/error - handle)" 1
  286:        (let/cc k
  287:          (call-with-output-process '(cat NoSuchFile)
  288:            port->string
  289:            :error "test1.o"
  290:            :on-abnormal-exit (lambda (p)
  291:                                (k (sys-wait-exit-status
  292:                                    (process-exit-status p)))))))
  293: 
  294: (sys-system "rm -f test1.o test2.o")
  295: 
  296: (test* "with-output-to-process" '(#t 1 2)
  297:        (let1 s (call-with-input-file "test.o" port->string)
  298:          (sys-system "rm -f test.o")
  299:          (receive (x y)
  300:              (with-output-to-process "cat > test.o"
  301:                (lambda () (display s) (values 1 2)))
  302:            (let1 r (call-with-input-file "test.o" port->string)
  303:              (list (equal? r s) x y)))))
  304: 
  305: (test* "with-output-to-process (redirect)" '(#t 1 2)
  306:        (let1 s (call-with-input-file "test.o" port->string)
  307:          (sys-system "rm -f test.o")
  308:          (receive (x y)
  309:              (with-output-to-process '(cat)
  310:                (lambda () (display s) (values 1 2))
  311:                :output "test.o")
  312:            (let1 r (call-with-input-file "test.o" port->string)
  313:              (list (equal? r s) x y)))))
  314: 
  315: (test* "call-with-process-io" "test.o\n"
  316:        (let* ((s (call-with-input-file "test.o" port->string))
  317:               (r (call-with-process-io '(grep "test\\.o")
  318:                    (lambda (i o)
  319:                      (display s o) (close-output-port o)
  320:                      (port->string i)))))
  321:          r))
  322: 
  323: (test* "call-with-process-io (redirect/error)" #t
  324:        (begin
  325:          (call-with-process-io "cat NoSuchFile"
  326:            (lambda (i o) #f)
  327:            :error "test1.o" :on-abnormal-exit :ignore)
  328:          (sys-system "cat NoSuchFile 2> test2.o")
  329:          (let ((r (call-with-input-file "test1.o" port->string))
  330:                (s (call-with-input-file "test2.o" port->string)))
  331:            (equal? r s))))
  332: 
  333: (sys-system "rm -rf test.o test1.o test2.o")
  334: (sys-system "touch test.o")
  335: (sys-system "ls -a > test.o")
  336: 
  337: (test* "process-output->string" #t
  338:        (let ((r (process-output->string '(ls -a)))
  339:              (s (call-with-input-file "test.o" port->string)))
  340:          (equal? r (string-join (string-tokenize s) " "))))
  341: 
  342: (test* "process-output->string (error - ignore)" ""
  343:        (process-output->string '(cat "NoSuchFile")
  344:                                :error "/dev/null"
  345:                                :on-abnormal-exit :ignore))
  346: 
  347: (test* "process-output->string (error - raise)" '<process-abnormal-exit>
  348:        (guard (e (else (class-name (class-of e))))
  349:          (process-output->string '(cat "NoSuchFile")
  350:                                  :error "/dev/null")))
  351: 
  352: (test* "process-output->string-list" #t
  353:        (let ((r (process-output->string-list '(ls -a)))
  354:              (s (call-with-input-file "test.o" port->string-list)))
  355:          (equal? r s)))
  356: 
  357: (test-end)