blob: 639e256c1b12bb465a971888971653348074f5af (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
(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* ((buf-mod (trunc (expt 256 page-size) 2))
(mk-rnd-buf (ret (flow buf-mod rand (+ buf-mod) buf-uint)))
(rndbuf0 [mk-rnd-buf])
(rndbuf1 [mk-rnd-buf])
(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 (eq (os-symbol) :bsd)
(test (ignerr (mmap (ffi char) 4096 prot-read map-anon)) nil))
|
