;*---------------------------------------------------------------------*/
;*    serrano/prgm/project/bigloo/recette/process.scm                  */
;*                                                                     */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Sat Nov 28 10:52:56 1992                          */
;*    Last change :  Wed Dec 10 10:41:55 2003 (serrano)                */
;*                                                                     */
;*    Process tests                                                    */
;*---------------------------------------------------------------------*/

;*---------------------------------------------------------------------*/
;*    Le module                                                        */
;*---------------------------------------------------------------------*/
(module process
  (import  (main "main.scm"))
  (include "test.sch")
  (export  (test-process)))

;*---------------------------------------------------------------------*/
;*    test-number ...                                                  */
;*---------------------------------------------------------------------*/
(define (test-process)
   (test-module "process" "process.scm")
   (test "output: pipe:"
	 (let* ((proc (run-process *bigloo-path*
				   "-eval"
				   "(begin (print (+ 41 27)) (exit 1))"
				   wait: #t
				   output: pipe:))
		(proc-output (process-output-port proc))
		(line (read-line proc-output)))
	    (close-input-port proc-output)
	    (let* ((v1 (process-alive? proc))
		   (v2 (process-exit-status proc))
		   (v3 line))
	       (or (not v1)
		   (and (eq? v1 1)
			(string=? v3 "68")))))
	 #t)
   (test "output: file"
	 (let ((temp-filename "process.output.tmp"))
	    (delete-file temp-filename)
	    (and (not (file-exists? temp-filename))
		 (unwind-protect
		    (let ((proc (run-process *bigloo-path*
					     "-eval"
					     "(begin (print (- 27 95)) (exit 2))"
					     wait: #t
					     output: temp-filename)))
		       (call-with-input-file temp-filename
			  (lambda (port)
			     (let* ((v1 (process-alive? proc))
				    (v2 (process-exit-status proc))
				    (v3 (read-line port)))
				(or (not v1)
				    (and (eq? v2 2)
					 (string=? v3 "-68")))))))
		    (if (file-exists? temp-filename)
			(delete-file temp-filename)))))
	 #t)
   (test "error: pipe:"
	 (let* ((proc (run-process *bigloo-path*
				   "-eval"
				   "(begin (fprint (current-error-port) (* 68 2)) (exit 3))"
				   wait: #t
				   error: pipe:))
		(proc-error (process-error-port proc))
		(line (read-line proc-error)))
	    (close-input-port proc-error)
	    (list (process-alive? proc) (process-exit-status proc) line))
	 '(#f 3 "136"))
   (test "error: file"
	 (let ((temp-filename "process.error.tmp"))
	    (delete-file temp-filename)
	    (and (not (file-exists? temp-filename))
		 (unwind-protect
		    (let ((proc (run-process *bigloo-path*
					     "-eval"
					     "(begin (fprint (current-error-port) (* 68 -2)) (exit 4))"
					     wait: #t
					     error: temp-filename)))
		       (call-with-input-file temp-filename
			  (lambda (port)
			     (let* ((v1 (process-alive? proc))
				    (v2 (process-exit-status proc))
				    (v3 (read-line port)))
				(or (not v1)
				    (and (eq? v2 5)
					 (string=? v3 "-204")))))))
		    (if (file-exists? temp-filename)
			(delete-file temp-filename)))))
	 #t)
   (test "input: file"
	 (let ((temp-filename "process.input.tmp"))
	    (delete-file temp-filename)
	    (and (not (file-exists? temp-filename))
		 (unwind-protect
		    (begin
		       (call-with-output-file temp-filename
			  (lambda (port)
			     (fprint port "(* 68 -3)")))
		       (let* ((proc (run-process *bigloo-path*
						 "-eval"
						 "(begin (print (eval (read))) (exit 5))"
						 wait: #t
						 input: temp-filename
						 output: pipe:))
			      (proc-output (process-output-port proc))
			      (line (read-line proc-output)))
			  (close-input-port proc-output)
			  (let* ((v1 (process-alive? proc))
				 (v2 (process-exit-status proc))
				 (v3 line))
			     (or (not v1)
				 (and (eq? v2 5)
				      (string=? v3 "-204"))))))
		    (if (file-exists? temp-filename)
			(delete-file temp-filename)))))
	 #t)
   (test "input: pipe:"
	 (let* ((proc (run-process *bigloo-path*
				   "-eval" 
				   "(begin (print (eval (read))) (exit 6))"
				   wait: #f
				   input: pipe:
				   output: pipe:))
		(proc-input (process-input-port proc))
		(proc-output (process-output-port proc)))
	    (fprint proc-input "(* 68 3)")
	    (close-output-port proc-input)
	    (let ((line (read-line proc-output)))
	       (process-wait proc)
	       (close-input-port proc-output)
	       (let* ((v1 (process-alive? proc))
		      (v2 (process-exit-status proc))
		      (v3 line))
		  (or (not v1)
		      (and (eq? v2 6)
			   (string=? v3 "204"))))))
	 #t)
   (cond-expand
      ;; no access to environment variables in Java
      (bigloo-jvm #f)          
      (else (test "env:"
		  (let* ((proc (run-process *bigloo-path*
					    "-eval"
					    "(begin (print (getenv \"foo\")) (exit 7))"
					    wait: #t
					    output: pipe:
					    env: "foo=bar"))
			 (proc-output (process-output-port proc))
			 (line (read-line proc-output)))
		     (close-input-port proc-output)
		     (let* ((v1 (process-alive? proc))
			    (v2 (process-exit-status proc))
			    (v3 line))
			(or (not v1)
			    (and (eq? v2 7)
				 (string=? v3 "bar")))))
		  #t)))
  (test "kill"
        (let ((proc (run-process *bigloo-path*
                                 "-eval" 
                                 "(define (loop) (sleep 100) (loop)) (loop)"
                                 wait: #f)))
          (list (process-alive? proc)
                (begin (sleep 500) (process-kill proc) (sleep 500) '-)
                (process-alive? proc)))
        '(#t - #f)))
