(import (chicken bitwise)
        (chicken condition)
        (chicken file)
        (chicken file posix)
        (chicken port)
        (chicken process)
        (chicken process signal)
        (chicken process-context posix)
        (chicken time)
        (fuse)
        (test))

(define u+rwx/reg (bitwise-ior file/reg perm/irusr perm/iwusr perm/ixusr))
(define u+rwx/dir (bitwise-ior file/dir perm/irusr perm/iwusr perm/ixusr))

(define (open-pipe)
  (receive (i o) (create-pipe)
    (make-bidirectional-port (open-input-file* i) (open-output-file* o))))

(define (test-exception path)
  (define pipe
    (open-pipe))
  (define pid
    (let ((fs (make-filesystem
               getattr: (lambda (path)
                          (cond
                            ((string=? path "/")
                             (vector u+rwx/dir
                                     2
                                     (current-user-id)
                                     (current-group-id)
                                     0
                                     (current-seconds)
                                     (current-seconds)
                                     (current-seconds)))
                            ((string=? path "/error")
                             (vector u+rwx/reg
                                     1
                                     (current-user-id)
                                     (current-group-id)
                                     0
                                     (current-seconds)
                                     (current-seconds)
                                     (current-seconds)))
                            (else #f)))
               readdir: (lambda (path)
                          (and (string=? path "/")
                               (list "." ".." "error")))
               open:    (lambda (path mode)
                          (error 'open "Error opening path" path mode)))))
      (process-fork
       (lambda ()
         (set-signal-handler! signal/term (lambda (_) (filesystem-stop! path fs)))
         (let ((n 0))
           (with-exception-handler
            (lambda (e)
              (set! n (add1 n)))
            (lambda ()
              (filesystem-start! path fs)
              (write (filesystem-wait! path fs 'started) pipe)
              (close-input-port pipe)
              (close-output-port pipe)
              (filesystem-wait! path fs 'stopped)
              (exit n))))))))
  (close-output-port pipe)
  (let ((mounted (read pipe)))
    (close-input-port pipe)
    (test-assert (equal? mounted #t))
    (unless (not mounted)
      (let ((file (string-append path "/error")))
        (do ((n 0 (add1 n)))
            ((= n 10)
             (process-signal pid signal/term)
             (let ((exit-status (nth-value 2 (process-wait pid))))
               (test-assert (positive? exit-status))))
          (test-error (file-open file open/read)))))))

(let ((path (create-temporary-directory)))
  (create-directory path #t)
  (test-exception path)
  (delete-directory path #t))