test/test-ladder.sgl — sigil-audio

1;;; Tests for (sigil audio ladder)

2;;;

3;;; A fake clock drives every test: a pull "costs" what the test says, so a

4;;; slow producer is forced rather than hoped for. Budget 4 ms per 60 fps

5;;; frame; at 48000 a frame is 800 frames of audio, so a pull of 800 frames

6;;; costing 8 ms is twice the budget.

8(import (sigil test)

9 (sigil math)

10 (sigil time)

11 (sigil audio ladder))

13(define now 0)

14(define (clock) now)

15(define (advance! ms) (set! now (+ now ms)))

17(define (ladder . extra)

18 (set! now 0)

19 (apply make-rate-ladder 48000 clock: clock budget-ms: 4.0 floor: 22050 extra))

21;; Pull n times at `rate`, each pull 800 device-rate-frame-equivalents costing

22;; `per-frame` ms per 60 fps frame, 16 ms apart. Answers the pulls measured.

23(define (pulls! l n per-frame)

24 (let loop ((i 0) (measured 0))

25 (if (>= i n)

26 measured

27 (let* ((rate (rate-ladder-rate l))

28 (frames (/ rate 60))

29 (ok (rate-ladder-record! l per-frame frames)))

30 (advance! 16)

31 (loop (+ i 1) (if ok (+ measured 1) measured))))))

33;; One window after the skip: 30 skipped pulls, then 60 measured, then a step.

34(define (window! l per-frame)

35 (pulls! l 90 per-frame)

36 (rate-ladder-step! l))

38(test-group "starting state"

39 (test "starts at the device's rate, for the device's reason"

40 (let ((l (ladder)))

41 (assert-equal 48000 (rate-ladder-rate l))

42 (assert-equal 'device (rate-ladder-reason l))

43 (assert-equal "48000/48000 BY DEVICE" (rate-ladder-report l))))

45 (test "rungs at or above the device's rate, or below the floor, are dropped"

46 (let ((l (make-rate-ladder 44100 rungs: '(48000 44100 32000 16000 24000) floor: 22050 clock: clock)))

47 (assert-equal '(32000 24000) (rate-ladder-rungs l)))))

49(test-group "a slow producer steps down, never up"

50 (test "twice over budget: 48000 -> 32000 -> 24000 -> 22050, then the floor holds"

51 (let* ((l (ladder))

52 (steps (list (window! l 8.0) (window! l 8.0) (window! l 8.0) (window! l 8.0) (window! l 8.0))))

53 (assert-equal '(32000 24000 22050 #f #f) steps)

54 (assert-equal 22050 (rate-ladder-rate l))

55 (assert-true (pair? (rate-ladder-reason l)))

56 (assert-equal 'ladder (car (rate-ladder-reason l)))))

58 (test "a producer that turns fast after a step does not raise the rate"

59 (let ((l (ladder)))

60 (assert-equal 32000 (window! l 8.0))

61 (assert-equal 24000 (window! l 8.0))

62 ;; now ten windows at a tenth of the budget

63 (let loop ((i 0) (stepped '()))

64 (if (< i 10)

65 (loop (+ i 1) (cons (window! l 0.4) stepped))

66 (begin

67 (assert-equal '(#f #f #f #f #f #f #f #f #f #f) stepped)

68 (assert-equal 24000 (rate-ladder-rate l)))))))

70 (test "under budget, nothing steps and the cost is reported"

71 (let ((l (ladder)))

72 (assert-false (window! l 3.9))

73 (assert-equal 48000 (rate-ladder-rate l))

74 (assert-true (< (abs (- (rate-ladder-last-cost l) 3.9)) 1e-9))))

76 (test "the reason names the second the step happened"

77 (let ((l (ladder)))

78 (window! l 8.0)

79 ;; 90 pulls 16 ms apart: the step is decided at 1440 ms

80 (assert-equal '(ladder . 1.4) (rate-ladder-reason l))

81 (assert-equal "48000/32000 BY LADDER@1.4S" (rate-ladder-report l)))))

83(test-group "the median decides, never one pull"

84 (test "59 steady pulls and one hostile one: no step, though the mean is over budget"

85 (let ((l (ladder)))

86 (pulls! l 30 2.0) ; the skip

87 (pulls! l 59 2.0)

88 (pulls! l 1 400.0) ; a tap's frame that slipped the quiet rule

89 ;; the mean of that window is (59*2 + 400)/60 = 8.6 ms: twice the budget

90 (assert-true (> (/ (+ (* 59 2.0) 400.0) 60) 4.0))

91 (assert-false (rate-ladder-step! l))

92 (assert-equal 48000 (rate-ladder-rate l))

93 (assert-equal 2.0 (rate-ladder-last-cost l)))))

95(test-group "refused pulls"

96 (test "the first 30 pulls after making the ladder are skipped"

97 (let ((l (ladder)))

98 (assert-equal 0 (pulls! l 30 8.0))

99 (assert-equal 60 (pulls! l 60 8.0))))

100

101 (test "pulls within 150 ms of a cue are not measured"

102 (let ((l (ladder)))

103 (pulls! l 30 1.0)

104 (rate-ladder-quiet! l)

105 ;; 16 ms apart: pulls at +0 .. +144 are inside the quiet window (10 of them)

106 (assert-equal 0 (pulls! l 10 50.0))

107 (assert-equal 5 (pulls! l 5 1.0))

108 (assert-equal 5 (rate-ladder-pulls l))))

109

110 (test "a burst of cues never lets a slow tap's frame decide"

111 (let ((l (ladder)))

112 (pulls! l 30 1.0)

113 ;; every 10th pull is a tap: quiet, then a hostile 100 ms pull in its frame

114 (let loop ((i 0))

115 (when (< i 60)

116 (rate-ladder-quiet! l)

117 (rate-ladder-record! l 100.0 800)

118 (advance! 200)

119 (pulls! l 9 1.0)

120 (loop (+ i 1))))

121 (assert-false (rate-ladder-step! l))

122 (assert-equal 1.0 (rate-ladder-last-cost l))))

123

124 (test "an open refuses the next 30 pulls and restarts the window"

125 (let ((l (ladder)))

126 (pulls! l 30 1.0)

127 (pulls! l 40 1.0)

128 (assert-equal 40 (rate-ladder-pulls l))

129 (rate-ladder-opened! l)

130 (advance! 200)

131 (assert-equal 0 (rate-ladder-pulls l))

132 (assert-equal 0 (pulls! l 30 1.0))

133 (assert-equal 1 (pulls! l 1 1.0))))

134

135 (test "a step refuses the next 30 pulls (the producer reopens)"

136 (let ((l (ladder)))

137 (assert-equal 32000 (window! l 8.0))

138 (assert-equal 0 (pulls! l 30 8.0))

139 (assert-equal 1 (pulls! l 1 8.0))))

140

141 (test "a full window refuses pulls until the step reads it"

142 (let ((l (ladder)))

143 (pulls! l 30 1.0)

144 (assert-equal 60 (pulls! l 70 1.0))

145 (assert-false (rate-ladder-step! l))

146 (assert-equal 1 (pulls! l 1 1.0))))

147

148 (test "a pull of no frames is refused"

149 (let ((l (ladder skip: 0)))

150 (assert-false (rate-ladder-record! l 1.0 0)))))

151

152(test-group "measuring"

153 (test "rate-ladder-measure times the thunk and answers its value"

154 (let ((l (ladder skip: 0)))

155 (advance! 1000)

156 (assert-equal 'pulled (rate-ladder-measure l 800 (lambda () (advance! 3) 'pulled)))

157 (assert-equal 1 (rate-ladder-pulls l))))

158

159 (test "the cost is per 60 fps frame at the ladder's rate"

160 (let ((l (ladder skip: 0 window: 1)))

161 (advance! 1000)

162 ;; 1600 frames at 48000 in 8 ms: a 60 fps frame (800 frames) costs 4 ms

163 (rate-ladder-record! l 8.0 1600)

164 (rate-ladder-step! l)

165 (assert-equal 4.0 (rate-ladder-last-cost l)))))

166

167(test-group "pin, hint and stored"

168 (test "a pinned ladder never steps, however slow"

169 (let ((l (ladder)))

170 (rate-ladder-pin! l 48000)

171 (assert-false (window! l 50.0))

172 (assert-equal "48000/48000 BY PIN" (rate-ladder-report l))))

173

174 (test "unpin returns to the device's rate and the ladder runs"

175 (let ((l (ladder)))

176 (rate-ladder-pin! l 24000)

177 (rate-ladder-unpin! l)

178 (assert-equal 48000 (rate-ladder-rate l))

179 (assert-equal 32000 (window! l 8.0))))

180

181 (test "a hint starts lower; it does not apply over a pin or after a step"

182 (let ((l (ladder)))

183 (assert-true (rate-ladder-hint! l 24000))

184 (assert-equal "48000/24000 BY HINT" (rate-ladder-report l))

185 (assert-equal 22050 (window! l 8.0)))

186 (let ((l (ladder)))

187 (rate-ladder-pin! l 32000)

188 (assert-false (rate-ladder-hint! l 24000))

189 (assert-equal 32000 (rate-ladder-rate l)))

190 (let ((l (ladder)))

191 (window! l 8.0)

192 (assert-false (rate-ladder-hint! l 24000))))

193

194 (test "a step hands the remember procedure the rate and the key"

195 (let* ((kept #f)

196 (l (ladder key: "ring 12288" remember: (lambda (s) (set! kept s)))))

197 (window! l 8.0)

198 (assert-equal "32000 ring 12288" kept)))

199

200 (test "a stored rate is restored under the same buffering key"

201 (let ((l (ladder key: "ring 12288")))

202 (assert-equal 24000 (rate-ladder-restore! l "24000 ring 12288"))

203 (assert-equal "48000/24000 BY STORED" (rate-ladder-report l))))

204

205 (test "a stored rate measured under another buffering is ignored"

206 (let ((l (ladder key: "ring 15360")))

207 (assert-false (rate-ladder-restore! l "24000 ring 12288"))

208 (assert-equal 48000 (rate-ladder-rate l))

209 (assert-equal 'device (rate-ladder-reason l))))

210

211 (test "a restore never raises the rate, and a garbled string is ignored"

212 (let ((l (ladder key: "k")))

213 (window! l 8.0)

214 (window! l 8.0)

215 (assert-false (rate-ladder-restore! l "32000 k"))

216 (assert-equal 24000 (rate-ladder-rate l))

217 (assert-false (rate-ladder-restore! l "fast k"))

218 (assert-false (rate-ladder-restore! l "22050"))

219 (assert-false (rate-ladder-restore! l #f)))))

220

221(test-group "the review's findings"

222 (test "the default clock resolves well under a millisecond"

223 (let ((l (make-rate-ladder 48000 skip: 0 window: 1 quiet-ms: 0)))

224 ;; a pull that spins 0.3 ms on the jiffy clock, 800 frames at 48000

225 ;; (one 60 fps frame): its cost is its time

226 (rate-ladder-measure l 800

227 (lambda ()

228 (let ((t0 (current-jiffy))

229 (need (* 0.0003 (jiffies-per-second))))

230 (let spin ()

231 (when (< (- (current-jiffy) t0) need) (spin))))))

232 (rate-ladder-step! l)

233 (let ((cost (rate-ladder-last-cost l)))

234 (assert-true (>= cost 0.3))

235 ;; a whole-millisecond clock can only answer 0, 1, 2...

236 (assert-false (integer? cost)))))

237

238 (test "a hint below the floor is refused"

239 (let ((l (ladder)))

240 (assert-false (rate-ladder-hint! l 11025))

241 (assert-equal 48000 (rate-ladder-rate l))))

242

243 (test "a stored rate below the floor is refused"

244 (let ((l (ladder key: "k")))

245 (assert-false (rate-ladder-restore! l "8000 k"))

246 (assert-equal 48000 (rate-ladder-rate l))))

247

248 (test "with no floor given, the lowest rung is the floor"

249 (let ((l (make-rate-ladder 48000 rungs: '(32000 24000) clock: clock)))

250 (assert-false (rate-ladder-hint! l 22050))

251 (assert-true (rate-ladder-hint! l 24000))))

252

253 (test "with the default key the remembered string is the bare rate, and it restores"

254 (let* ((kept #f)

255 (l (ladder remember: (lambda (s) (set! kept s)))))

256 (window! l 8.0)

257 (assert-equal "32000" kept)

258 (let ((l2 (ladder)))

259 (assert-equal 32000 (rate-ladder-restore! l2 kept)))))

260

261 (test "unpin raises the rate back to the device's"

262 (let ((l (ladder)))

263 (rate-ladder-pin! l 24000)

264 (assert-equal 48000 (rate-ladder-unpin! l)))))