; Verify interprocess commmunication/syncronization
; Run this script in another process to see that they really serialize
;
; IMPORT
; appropriate prelude: myenv.scm, myenv-bigloo.scm, myenv-scm.scm
;	depending on your system
; catch-error.scm -- for procedure, for-syntax
;
; $Id: vipc.scm,v 1.4 2002/11/14 04:57:36 oleg Exp oleg $

(declare				; Compilation optimization options
 (block)
 (standard-bindings)
)

(define MKNOD_COMMAND "mkfifo ")
;(define MKNOD_COMMAND "/etc/mknod ")


	; Check out that the 'form' has failed indeed
	; (as it was supposed to)
(define-macro (must-have-failed form)
  `(assert (failed?
      (##catch-all
        (lambda (sig args) (error "catching " sig args))
        (lambda () ,form)))))


(cerr "about to enter the critical section\n"
  (OS:within-critical-section "/tmp/lock"
    (lambda ()
      (cerr "Inside the critical section\n")
      (do ((i 0 (++ i))) ((>= i 5) "Leaving the section\n")
        (OS:sleep 5)
        (cerr "sleeping...")))))
(cerr "\nDone\n")


(cerr "\nTesting of timing out...\n")
(let ((pipe-name (OS:tmpnam)) (timeout 5) (test-str "123 45"))

	; read from the file and return everything we've read in a string
  (define (pipe-reader)
    (with-input-from-file pipe-name
      (lambda ()
        (let loop ((chars-l '()))
          (let ((c (read-char)))
            (if (eof-object? c) (apply string (reverse chars-l))
              (loop (cons c chars-l))))))))

  (cerr "\nLetting a "  timeout
    "-sec alarm expire trying to read from an empty pipe "
    pipe-name nl)
  (OS:remove pipe-name)
  (OS:system MKNOD_COMMAND pipe-name " p")
  (must-have-failed (OS:within-timeout timeout pipe-reader))

  (cerr "\nWriting into the pipe before a "  timeout
    "-sec alarm set to expire\n")
  (OS:remove pipe-name)
  (OS:system MKNOD_COMMAND pipe-name " p")
  (OS:system "( sleep 1; echo '" test-str "' > " pipe-name
      " )&")
  (let ((read-str 
        (OS:within-timeout timeout pipe-reader)))
    (cerr "\nread: " read-str nl)
    (assert (string=? read-str (string-append test-str "\n"))))

  (cerr "\nWriting into the pipe after a "  timeout
	"-sec alarm set to expire\n"
	"Testing that a read(2) from a pipe can be interrupted\n")
  (OS:remove pipe-name)
  (OS:system MKNOD_COMMAND pipe-name " p")
  (OS:system "( echo '" test-str "'"
	     "; sleep " (number->string (+ 2 timeout))
	     "; echo '" test-str "'"
	     " ) > " pipe-name "&")
  (let ((read-str 
        (OS:within-timeout timeout pipe-reader)))
    (cerr "\nread: " read-str nl)
    (assert (string=? read-str (string-append test-str "\n"))))
)

; testing keep-alive
; You have to wait really long...
; (let ((port (##open-input-file "tcp://localhost:80")))
;   (display (OS:set-keep-alive port)) (newline)
;   (assert (equal? "" (read-string 5 port))))


(cerr "\nDone\n")