test/test-sink-rate-split.sgl

1;;; The native sink's resampling, rate changes and underrun split, and the

2;;; facade's native cues.

3;;;

4;;; No device is opened: %audio-stream-drain-for-test runs the audio

5;;; thread's mix over a bytevector, so every frame is deterministic. Each

6;;; test closes its streams (the mix drains every open one).

8(import (sigil test)

9 (sigil math)

10 (sigil audio)

11 (only (sigil audio sink) load-audio-cue audio-cue? play-audio-cue

12 unload-audio-cue! audio-cue-mode audio-cue-lag

13 audio-stream-underruns-idle))

15(define DEVICE 44100)

16(define PI 3.141592653589793)

18;; n stereo frames, frame i = (f i) on both channels

19(define (frames n f)

20 (let ((v (make-vector (* 2 n) 0.0)))

21 (let loop ((i 0))

22 (when (< i n)

23 (let ((x (* 1.0 (f i))))

24 (vector-set! v (* 2 i) x)

25 (vector-set! v (+ (* 2 i) 1) (- x)))

26 (loop (+ i 1))))

27 (make-float-buffer v)))

29;; drain n device frames; answers a vector of the left channel

30(define (drain n)

31 (let ((out (make-bytevector (* n 2 4) 0)))

32 (%audio-stream-drain-for-test out n 2)

33 (let ((v (make-vector n 0.0)))

34 (let loop ((i 0))

35 (when (< i n)

36 (vector-set! v i (%bv-f32-ref out (* i 8)))

37 (loop (+ i 1))))

38 v)))

40(define (right-of n)

41 (let ((out (make-bytevector (* n 2 4) 0)))

42 (%audio-stream-drain-for-test out n 2)

43 (%bv-f32-ref out 4)))

45;; zero crossings over v[a, b) as a frequency at the device's rate

46(define (freq v a b)

47 (let loop ((i (+ a 1)) (n 0))

48 (if (>= i b)

49 (* (/ n 2.0) (/ DEVICE (- b a)))

50 (loop (+ i 1)

51 (if (eq? (< (vector-ref v (- i 1)) 0) (< (vector-ref v i) 0)) n (+ n 1))))))

53(define (sine rate)

54 (lambda (i) (* 0.2 (sin (/ (* 2 PI 440 i) rate)))))

56(test-group "underruns split by what the listener lost"

57 (test "a stream never fed runs dry idle"

58 (let ((s (open-audio-stream buffer-frames: 4096)))

59 (drain 256)

60 (assert-equal 256 (audio-stream-underruns s))

61 (assert-equal 0 (audio-stream-underruns-sounding s))

62 (assert-equal 256 (audio-stream-underruns-idle s))

63 (close-audio-stream! s)))

65 (test "dry after silence is idle; dry after sound is sounding"

66 (let ((s (open-audio-stream buffer-frames: 4096)))

67 (push-audio-samples s (frames 256 (lambda (i) 0.0)) 256)

68 (drain 512)

69 (assert-equal 256 (audio-stream-underruns s))

70 (assert-equal 0 (audio-stream-underruns-sounding s))

71 (push-audio-samples s (frames 256 (sine DEVICE)) 256)

72 (drain 512)

73 (assert-equal 512 (audio-stream-underruns s))

74 (assert-equal 256 (audio-stream-underruns-sounding s))

75 (close-audio-stream! s)))

77 (test "sound that faded to silence 200 frames before the ring ran dry is idle"

78 (let ((s (open-audio-stream buffer-frames: 4096)))

79 (push-audio-samples s (frames 128 (sine DEVICE)) 128)

80 (push-audio-samples s (frames 200 (lambda (i) 0.0)) 200)

81 (drain 428)

82 (assert-equal 100 (audio-stream-underruns s))

83 (assert-equal 0 (audio-stream-underruns-sounding s))

84 (close-audio-stream! s)))

86 (test "the hold is 128 frames: dry 127 quiet frames after sound is sounding, 128 idle"

87 (let ((s (open-audio-stream buffer-frames: 4096)))

88 (push-audio-samples s (frames 64 (lambda (i) 0.1)) 64)

89 (push-audio-samples s (frames 127 (lambda (i) 0.0)) 127)

90 (drain (+ 64 127 10))

91 (assert-equal 10 (audio-stream-underruns-sounding s))

92 (push-audio-samples s (frames 64 (lambda (i) 0.1)) 64)

93 (push-audio-samples s (frames 128 (lambda (i) 0.0)) 128)

94 (drain (+ 64 128 10))

95 (assert-equal 10 (audio-stream-underruns-sounding s))

96 (assert-equal 20 (audio-stream-underruns s))

97 (close-audio-stream! s)))

99 (test "sound at volume 0 is not heard: dry after it is idle"

100 (let ((s (open-audio-stream buffer-frames: 4096 volume: 0.0)))

101 (push-audio-samples s (frames 256 (sine DEVICE)) 256)

102 (drain 512)

103 (assert-equal 256 (audio-stream-underruns s))

104 (assert-equal 0 (audio-stream-underruns-sounding s))

105 (close-audio-stream! s))))

106

107(test-group "a stream fed below the device's rate"

108 (test "a new stream feeds at the device's rate"

109 (let ((s (open-audio-stream)))

110 (assert-equal DEVICE (audio-stream-rate s))

111 (close-audio-stream! s)))

112

113 (test "at 22050 a 440 Hz tone plays at 440 Hz, for twice its frames"

114 (let* ((s (open-audio-stream buffer-frames: 16384 rate: 22050))

115 (n 4410))

116 (assert-equal 22050 (audio-stream-rate s))

117 (assert-equal n (push-audio-samples s (frames n (sine 22050)) n))

118 (let* ((v (drain 9000))

119 (under (audio-stream-underruns s))

120 (played (- 9000 under)))

121 ;; 4410 frames at half the rate: 8820 at the output, less the two

122 ;; the cubic needs ahead of its last position

123 (assert-true (<= (abs (- played 8820)) 4))

124 (assert-true (< (abs (- (freq v 100 8700) 440)) 5))

125 ;; against the ideal tone at the output rate

126 (let loop ((i 64) (err 0.0))

127 (if (< i 8700)

128 (loop (+ i 1) (+ err (square (- (vector-ref v i) ((sine DEVICE) i)))))

129 (assert-true (< (sqrt (/ err (- 8700 64))) 0.0002)))))

130 (close-audio-stream! s)))

131

132 (test "the channels stay apart through the upsampler"

133 (let ((s (open-audio-stream buffer-frames: 16384 rate: 22050)))

134 (push-audio-samples s (frames 1000 (lambda (i) 0.3)) 1000)

135 (drain 64)

136 (assert-true (< (abs (+ 0.3 (right-of 1))) 1e-6))

137 (close-audio-stream! s)))

138

139 (test "a rate change lands at the head it was asked at"

140 (let ((s (open-audio-stream buffer-frames: 16384)))

141 (push-audio-samples s (frames 1024 (lambda (i) 0.25)) 1024)

142 (assert-true (set-audio-stream-rate! s 22050))

143 (push-audio-samples s (frames 1024 (lambda (i) 0.5)) 1024)

144 (let* ((v (drain 4000))

145 (played (- 4000 (audio-stream-underruns s))))

146 ;; the first 1024 frames are the device-rate frames, copied exactly

147 (assert-equal 0.25 (vector-ref v 0))

148 (assert-equal 0.25 (vector-ref v 1023))

149 ;; then 1024 frames at half the rate: about 2048 at the output

150 (assert-true (<= (abs (- played (+ 1024 2048))) 4))

151 (assert-true (< (abs (- (vector-ref v 2000) 0.5)) 1e-6)))

152 (close-audio-stream! s)))

153

154 (test "a rate above the device's is clamped; zero is refused"

155 (let ((s (open-audio-stream)))

156 (assert-true (set-audio-stream-rate! s 96000))

157 (assert-equal DEVICE (audio-stream-rate s))

158 (assert-false (set-audio-stream-rate! s 0))

159 (close-audio-stream! s)))

160

161 (test "eight changes may wait for the audio thread; a ninth is refused"

162 (let ((s (open-audio-stream)))

163 (let loop ((i 0) (ok '()))

164 (if (< i 9)

165 (loop (+ i 1) (cons (set-audio-stream-rate! s 22050) ok))

166 (assert-equal '(#f #t #t #t #t #t #t #t #t) ok)))

167 (close-audio-stream! s))))

168

169(test-group "cues on native"

170 (test "a cue loads from float32 PCM and plays through the device's sounds"

171 (let ((cue (load-audio-cue (frames 64 (lambda (i) 0.5)))))

172 (assert-true (audio-cue? cue))

173 (assert-equal 'device (audio-cue-mode))

174 (assert-false (audio-cue-lag))

175 (assert-true (play-audio-cue cue volume: 0.5))))

176

177 (test "an unloaded cue refuses to play"

178 (let ((cue (load-audio-cue (frames 64 (lambda (i) 0.5)) channels: 2)))

179 (assert-true (unload-audio-cue! cue))

180 (assert-false (play-audio-cue cue))

181 (assert-false (unload-audio-cue! cue))))

182

183 (test "a load of no PCM is refused"

184 (assert-false (load-audio-cue (make-bytevector 0 0)))

185 (assert-false (load-audio-cue "not pcm"))))