#!vicare
(import (vicare)
  (prefix (vicare posix) px.)
  (vicare platform constants)
  (vicare language-extensions syntaxes))

(define name "/vicare-test")

(define (parent child-pid)
  ;; Create a message queue and block until a message
  ;; is received from the child.
  ;;
  (let ((mqd (px.mq-open name
                         (bitwise-ior O_CREAT O_EXCL O_RDWR)
                         (bitwise-ior S_IRUSR S_IWUSR)
                         (px.make-struct-mq-attr 0 3 16 0)))
        (buf (make-bytevector 16)))
    (unwind-protect
        (let-values (((len priority)
                      (px.mq-receive mqd buf)))
          (px.waitpid child-pid 0)
          (list (subbytevector-u8 buf 0 len)
                priority))
      (px.mq-close mqd)
      (px.mq-unlink name))))

(define (child)
  ;; Wait for the parent to create the queue, then
  ;; send a message and exit.
  ;;
  (px.nanosleep 0 900000)
  (let ((mqd (px.mq-open name O_RDWR
                         (bitwise-ior S_IRUSR S_IWUSR)
                         (px.make-struct-mq-attr 0 3 16 0))))
    (unwind-protect
        (px.mq-send mqd '#ve(ascii "ciao") 1)
      (px.mq-close mqd)))
  (exit 0))

(px.fork parent child)

#!vicare
(import (vicare)
  (prefix (vicare posix) px.)
  (vicare platform constants)
  (vicare language-extensions syntaxes))

(define name "/vicare-test")

(define timeout
  (let ((T (px.clock-gettime CLOCK_REALTIME
              (px.make-struct-timespec 0 0))))
    (px.set-struct-timespec-tv_sec! T
       (+ 5 (px.struct-timespec-tv_sec T)))
    T))

(define (parent child-pid)
  ;; Create a message queue and block with timeout
  ;; until a message is received from the child.
  ;;
  (let ((mqd (px.mq-open name
                         (bitwise-ior O_CREAT O_EXCL O_RDWR)
                         (bitwise-ior S_IRUSR S_IWUSR)
                         (px.make-struct-mq-attr 0 3 16 0)))
        (buf (make-bytevector 16)))
    (unwind-protect
        (let-values (((len priority)
                      (px.mq-timedreceive mqd buf timeout)))
          (px.waitpid child-pid 0)
          (list (subbytevector-u8 buf 0 len)
                priority))
      (px.mq-close mqd)
      (px.mq-unlink name))))

(define (child)
  ;; Wait for the parent to create the queue, then
  ;; send a message with timeout and exit.
  ;;
  (px.nanosleep 0 900000)
  (let ((mqd (px.mq-open name
                         O_RDWR
                         (bitwise-ior S_IRUSR S_IWUSR)
                         (px.make-struct-mq-attr 0 3 16 0))))
    (unwind-protect
        (px.mq-timedsend mqd '#ve(ascii "ciao") 1 timeout)
      (px.mq-close mqd)))
  (exit 0))

(px.fork parent child)