test/test-streaming-sink.sgl

1;;; Test streaming audio sink

2;;;

3;;; Exercises the SPSC ring buffer without opening a real sokol_audio

4;;; device. %audio-stream-drain-for-test stands in for the audio

5;;; callback. Verifies push/consume parity, under-run, and over-run.

7(import (sigil core)

8 (sigil audio))

10(define failures 0)

12(define (check label actual expected)

13 (if (equal? actual expected)

14 (begin (display " ok: ") (display label) (newline))

15 (begin

16 (display " FAIL: ") (display label) (newline)

17 (display " expected: ") (display expected) (newline)

18 (display " actual: ") (display actual) (newline)

19 (set! failures (+ failures 1)))))

21(define (check-pred label actual pred)

22 (if (pred actual)

23 (begin (display " ok: ") (display label) (newline))

24 (begin

25 (display " FAIL: ") (display label) (newline)

26 (display " actual: ") (display actual) (newline)

27 (set! failures (+ failures 1)))))

29;; Build a stereo float32 bytevector of N frames where every sample == v.

30(define (const-frames n-frames channels v)

31 (let* ((n-samples (* n-frames channels))

32 (bv (make-float-buffer (make-vector n-samples v))))

33 bv))

35;; ------------------------------------------------------------

36;; Test 1: basic push / drain / depth accounting

37;; ------------------------------------------------------------

38(display "Test 1: basic push/drain (stereo, 2048-frame ring)\n")

39(let ((s (open-audio-stream channels: 2 buffer-frames: 2048)))

40 (check "audio-stream? true" (audio-stream? s) #t)

41 (check "depth initially zero" (audio-stream-depth s) 0)

42 ;; capacity rounds up to next power of two

43 (check-pred "capacity >= 2048" (audio-stream-capacity s) (lambda (c) (>= c 2048)))

44 (check "channels == 2" (audio-stream-channels s) 2)

46 (let* ((n 512)

47 (bv (const-frames n 2 0.25))

48 (accepted (push-audio-samples s bv n)))

49 (check "all 512 frames accepted" accepted n)

50 (check "depth == 512" (audio-stream-depth s) 512)

52 ;; Drain 256 frames via the test shim.

53 (let ((out (make-bytevector (* 256 2 4) 0)))

54 (%audio-stream-drain-for-test out 256 2)

55 (check "depth after drain 256" (audio-stream-depth s) 256)

56 ;; First float in out should be ~0.25 (our stream is the only

57 ;; source).

58 (check-pred "first sample == 0.25"

59 (%bv-f32-ref out 0)

60 (lambda (v) (< (abs (- v 0.25)) 1e-6))))

62 ;; Drain the remaining 256 plus 128 of silence — under-run.

63 (let ((out (make-bytevector (* 384 2 4) 0)))

64 (%audio-stream-drain-for-test out 384 2)

65 (check "depth zero after overflow drain" (audio-stream-depth s) 0)

66 (check-pred "underruns >= 128" (audio-stream-underruns s)

67 (lambda (u) (>= u 128)))

68 ;; First sample still from the stream (0.25), tail sample silence.

69 (check-pred "first sample still 0.25"

70 (%bv-f32-ref out 0)

71 (lambda (v) (< (abs (- v 0.25)) 1e-6)))

72 (check-pred "last sample is silence"

73 (%bv-f32-ref out (* (- 384 1) 2 4))

74 (lambda (v) (< (abs v) 1e-6)))))

75 (close-audio-stream! s)

76 (check "audio-stream-closed? after close" (audio-stream-closed? s) #t)

77 (check "push on closed returns 0"

78 (push-audio-samples s (const-frames 64 2 0.1) 64) 0))

80;; ------------------------------------------------------------

81;; Test 2: over-run — push more than capacity

82;; ------------------------------------------------------------

83(display "\nTest 2: over-run (push exceeds ring capacity)\n")

84(let* ((s (open-audio-stream channels: 2 buffer-frames: 1024))

85 (cap (audio-stream-capacity s))

86 (big (* cap 2)) ;; ask to push 2x capacity

87 (bv (const-frames big 2 0.5))

88 (accepted (push-audio-samples s bv big)))

89 (check-pred "accepted <= capacity" accepted (lambda (a) (<= a cap)))

90 (check-pred "accepted > 0" accepted (lambda (a) (> a 0)))

91 (check "depth == accepted" (audio-stream-depth s) accepted)

92 (check "room == 0 (full)" (audio-stream-room s) 0)

93 ;; A second push while full should accept 0.

94 (check "second push returns 0"

95 (push-audio-samples s (const-frames 128 2 0.9) 128) 0)

96 (close-audio-stream! s))

98;; ------------------------------------------------------------

99;; Test 3: mono stream duplicates to stereo out

100;; ------------------------------------------------------------

101(display "\nTest 3: mono stream duplicated into stereo out\n")

102(let ((s (open-audio-stream channels: 1 buffer-frames: 512)))

103 (check "channels == 1" (audio-stream-channels s) 1)

104 (let* ((n 128)

105 (bv (const-frames n 1 0.5))

106 (accepted (push-audio-samples s bv n)))

107 (check "mono push accepted 128" accepted n))

108 (let ((out (make-bytevector (* 128 2 4) 0)))

109 (%audio-stream-drain-for-test out 128 2)

110 (check-pred "L channel == 0.5"

111 (%bv-f32-ref out 0)

112 (lambda (v) (< (abs (- v 0.5)) 1e-6)))

113 (check-pred "R channel == 0.5"

114 (%bv-f32-ref out 4)

115 (lambda (v) (< (abs (- v 0.5)) 1e-6))))

116 (close-audio-stream! s))

117

118;; ------------------------------------------------------------

119;; Test 4: close is idempotent and depth/room safe on closed

120;; ------------------------------------------------------------

121(display "\nTest 4: close idempotent\n")

122(let ((s (open-audio-stream channels: 2 buffer-frames: 256)))

123 (close-audio-stream! s)

124 (close-audio-stream! s) ;; no crash

125 (check "closed? after double close" (audio-stream-closed? s) #t))

126

127;; ------------------------------------------------------------

128;; Test 5: volume set reflected in drained samples

129;; ------------------------------------------------------------

130(display "\nTest 5: set-audio-stream-volume!\n")

131(let ((s (open-audio-stream channels: 2 buffer-frames: 512 volume: 1.0)))

132 (set-audio-stream-volume! s 0.5)

133 (push-audio-samples s (const-frames 64 2 1.0) 64)

134 (let ((out (make-bytevector (* 64 2 4) 0)))

135 (%audio-stream-drain-for-test out 64 2)

136 (check-pred "sample scaled by 0.5"

137 (%bv-f32-ref out 0)

138 (lambda (v) (< (abs (- v 0.5)) 1e-6))))

139 (close-audio-stream! s))

140

141(newline)

142(if (= failures 0)

143 (display "All streaming-sink tests passed!\n")

144 (error "streaming-sink test failures" failures))