(load "../common")

(defun parent (wp mm)
  (with-stream (s (open-fileno wp "w"))
    (each ((i 0..1024))
      (set [mm i] i))
    (put-char #\X s)))

(defun child (rp mm)
  (let ((s (open-fileno rp "r")))
    (assert (eq (get-char s) #\X))
    (each ((i 0..1024))
      (assert (eql [mm i] i)))))

(let ((mm (mmap (ffi uint32) 4096
                (logior prot-read prot-write)
                (logior map-anon map-shared))))
  (tree-bind (rp . wp) (pipe)
    (match-ecase (fork)
      (0 (child rp mm)
         (exit t))
      (-1 (error "fork failed"))
      (@pid (parent wp mm)
            (tree-bind (p . s) (wait pid)
              (unless (zerop s)
                (error "child failed")))))))

(assert (plusp page-size))

(let* ((rndbuf0 (random-buf page-size))
       (rndbuf1 (random-buf page-size))
       (fname "rand.bin"))
  (unwind-protect
    (progn
      (file-put-buf fname rndbuf0)
      (let* ((mm (mmap (ffi uchar) page-size
                       (logior prot-read prot-write)
                       (logior map-shared)
                       fname)))
        (each ((i 0..page-size))
          (assert (eq [rndbuf0 i] [mm i]))
          (set [mm i] [rndbuf1 i]))
        (msync mm ms-sync)
        (assert (equal (file-get-buf fname) rndbuf1))
        (each ((i 0..page-size))
          (set [mm i] [rndbuf0 i]))
        (munmap mm))
      (assert (equal (file-get-buf fname) rndbuf0)))
    (remove-path fname)))

(unless (meq (os-symbol) :bsd :openbsd)
  (test (ignerr (mmap (ffi char) 4096 prot-read map-anon)) nil))