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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
;; This file is part of scheme-GNUnet.
;; Copyright (C) 2021 Maxime Devos
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL3.0-or-later
(use-modules (gnu gnunet concurrency update)
(srfi srfi-8)
(srfi srfi-11)
(srfi srfi-26)
(fibers operations)
(fibers timers)
(fibers))
(test-begin "update")
;; Tests without concurrency
(test-equal "make-update result types"
'(#t . #t)
(receive (update update!)
(make-update 0)
(cons (update? update)
(procedure? update!))))
(test-equal "update! and next-update-peek"
'(new #t #t)
(let*-values (((update update!) (make-update 'old))
((next-update next-update!) (update! 'new)))
(receive (next-update-peeked) (next-update-peek update)
(list (update-value next-update-peeked)
(procedure? next-update!)
(eq? next-update-peeked next-update)))))
(test-eq "no update! and next-update-peek"
#f
(next-update-peek (make-update 0)))
(test-error "update! twice -> &double-update"
&double-update
(receive (next-update next-update!)
(make-update 0)
(next-update! next-update)
(next-update! next-update)))
;; Tests with operations
;; Unfortunately, fibers does not not have
;; a ‘run this operation -- unless it would
;; block’ procedure, and using a combination
;; of wrap-operation and sleep-operation/
;; timer-operation turns out to be racy.
;;
;; Our approach:
;; * if an operation is expected to block,
;; include a short timer-operation
;; for testing detecting blocking.
;; (Short to ensure tests still pass
;; quickly.)
;;
;; A false ‘PASS’ could occassionally
;; result, but no false ‘FAIL’ will
;; be created.
;; * if a test is expected *not* to block,
;; just perform the operation.
;;
;; If the test terminates, it's a PASS,
;; if it loops forever, that would be a FAIL.
(define expected-blocking-operation
(wrap-operation (sleep-operation 1e-4)
(lambda () 'blocking)))
(test-eq "no update -> blocking next-update"
'blocking
(perform-operation
(choice-operation
(wrap-operation (wait-for-update-operation (make-update #f))
(lambda (_) 'nonblocking))
expected-blocking-operation)))
(test-eq "updated -> non-blocking next-update"
'nonblocking
(perform-operation
(receive (update update!)
(make-update 'old)
(update! 'new)
(wrap-operation (wait-for-update-operation update)
(lambda (update) 'nonblocking)))))
(receive (update update!)
(make-update 'old)
(let ((new (update! 'new)))
(test-eq "updated -> correct non-blocking next-update"
new
;; For unknown reasons, using choice-operation
;; and blocking-operation leads to a FAIL.
(perform-operation (wait-for-update-operation update)))))
(test-end "update")
|
