blob: d6b2781f2650d9fa97974ee891eaa6d4d8ed1b0e (
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
|
(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 (eq (os-symbol) :bsd)
(test (ignerr (mmap (ffi char) 4096 prot-read map-anon)) nil))
|
