guile-flac/tests/ietf-decoding-examples.scm

194 lines
7.5 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters!

This file contains invisible Unicode characters that may be processed differently from what appears below. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to reveal hidden characters.

;;; ietf-decoding-examples.scm -- Tests from the examples on the ietf document
;; Copyright (C) 2022 Steve Ayerhart <steve@ayerh.art>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; The program 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 General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with the program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(add-to-load-path (getenv "abs_top_srcdir"))
(use-modules (flac reader)
(flac format)
(flac metadata)
(flac decoder)
(rnrs bytevectors)
(ice-9 binary-ports)
(ice-9 receive)
(srfi srfi-64))
;;; https://www.ietf.org/archive/id/draft-ietf-cellar-flac-07.html#name-examples
(test-begin "IETF Examples")
(test-group "Example 1"
(define example-1
#vu8(#x66 #x4c #x61 #x43 #x80 #x00 #x00 #x22 #x10 #x00 #x10 #x00
#x00 #x00 #x0f #x00 #x00 #x0f #x0a #xc4 #x42 #xf0 #x00 #x00
#x00 #x01 #x3e #x84 #xb4 #x18 #x07 #xdc #x69 #x03 #x07 #x58
#x6a #x3d #xad #x1a #x2e #x0f #xff #xf8 #x69 #x18 #x00 #x00
#xbf #x03 #x58 #xfd #x03 #x12 #x8b #xaa #x9a))
(define expected-stream-info
(%make-metadata-stream-info
4096 4096 15 15 44100 2 16 1
#vu8(62 132 180 24 7 220 105 3 7 88 106 61 173 26 46 15)))
(define expected-frame
(%make-frame
(%make-frame-header 'fixed 1 44100 'independent 16 0 191)
43674 '((25588) (10416))))
(receive (actual-metadata actual-frame)
(with-flac-input-port (open-bytevector-input-port example-1)
(λ ()
(flac-read/assert-magic)
(let* ((metadata (read-flac-metadata))
(stream-info (flac-metadata-stream-info metadata)))
(values metadata
(read-flac-frame stream-info)))))
(test-group "Metadata"
(test-equal "stream info"
expected-stream-info (flac-metadata-stream-info actual-metadata)))
(test-group "Frame"
(test-equal "first frame" expected-frame actual-frame))))
(test-group "Example 2"
(define example-2
#vu8(#x66 #x4c #x61 #x43 #x00 #x00 #x00 #x22 #x00 #x10 #x00 #x10
#x00 #x00 #x17 #x00 #x00 #x44 #x0a #xc4 #x42 #xf0 #x00 #x00
#x00 #x13 #xd5 #xb0 #x56 #x49 #x75 #xe9 #x8b #x8d #x8b #x93
#x04 #x22 #x75 #x7b #x81 #x03 #x03 #x00 #x00 #x12 #x00 #x00
#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
#x00 #x00 #x00 #x10 #x04 #x00 #x00 #x3a #x20 #x00 #x00 #x00
#x72 #x65 #x66 #x65 #x72 #x65 #x6e #x63 #x65 #x20 #x6c #x69
#x62 #x46 #x4c #x41 #x43 #x20 #x31 #x2e #x33 #x2e #x33 #x20
#x32 #x30 #x31 #x39 #x30 #x38 #x30 #x34 #x01 #x00 #x00 #x00
#x0e #x00 #x00 #x00 #x54 #x49 #x54 #x4c #x45 #x3d #xd7 #xa9
#xd7 #x9c #xd7 #x95 #xd7 #x9d #x81 #x00 #x00 #x06 #x00 #x00
#x00 #x00 #x00 #x00 #xff #xf8 #x69 #x98 #x00 #x0f #x99 #x12
#x08 #x67 #x01 #x62 #x3d #x14 #x42 #x99 #x8f #x5d #xf7 #x0d
#x6f #xe0 #x0c #x17 #xca #xeb #x21 #x00 #x0e #xe7 #xa7 #x7a
#x24 #xa1 #x59 #x0c #x12 #x17 #xb6 #x03 #x09 #x7b #x78 #x4f
#xaa #x9a #x33 #xd2 #x85 #xe0 #x70 #xad #x5b #x1b #x48 #x51
#xb4 #x01 #x0d #x99 #xd2 #xcd #x1a #x68 #xf1 #xe6 #xb8 #x10
#xff #xf8 #x69 #x18 #x01 #x02 #xa4 #x02 #xc3 #x82 #xc4 #x0b
#xc1 #x4a #x03 #xee #x48 #xdd #x03 #xb6 #x7c #x13 #x30))
(define expected-stream-info
(%make-metadata-stream-info
16 16 23 68 44100 2 16 19
#vu8(213 176 86 73 117 233 139 141 139 147 4 34 117 123 129 3)))
(define expected-vorbis-comment
(%make-metadata-vorbis-comment
"reference libFLAC 1.3.3 20190804"
(list '("TITLE" "שלום"))))
(define expected-padding
(%make-metadata-padding 6))
(define expected-seek-table
(%make-metadata-seek-table
(list (%make-metadata-seek-point 0 0 16))))
(define expected-first-frame
(%make-frame
(%make-frame-header 'fixed 16 44100 'right 16 0 153)
47120
'((4302 7496 6199 7427 6484 7436 6740 7508 6984 7583 7182 -5990 -6306 -6032 -6299 -6165)
(6070 10545 8743 10449 9143 10463 9502 10569 9840 10680 10113 -8428 -8895 -8476 -8896 -8653))))
(define expected-second-frame
(%make-frame
(%make-frame-header 'fixed 3 44100 'independent 16 1 164)
4912
'((-15486 -15349 -16054)
(-9072 -8958 -9410))))
(receive (actual-metadata actual-first-frame actual-second-frame)
(with-flac-input-port (open-bytevector-input-port example-2)
(λ ()
(flac-read/assert-magic)
(let* ((metadata (read-flac-metadata))
(stream-info (flac-metadata-stream-info metadata)))
(values
metadata (read-flac-frame stream-info) (read-flac-frame stream-info)))))
(test-group "Metadata"
(test-equal "stream info"
(flac-metadata-stream-info actual-metadata)
expected-stream-info)
(test-equal "vorbis comment"
(flac-metadata-vorbis-comment actual-metadata)
expected-vorbis-comment)
(test-equal "padding"
(flac-metadata-padding actual-metadata)
expected-padding)
(test-equal "seek table"
(flac-metadata-seek-table actual-metadata)
expected-seek-table))
(test-group "Frames"
(test-equal "frame 1" expected-first-frame expected-first-frame)
(test-equal "frame 2" expected-second-frame expected-second-frame))))
(test-group "Example 3"
(define example-3
#vu8(#x66 #x4c #x61 #x43 #x80 #x00 #x00 #x22 #x10 #x00 #x10 #x00 #x00
#x00 #x1f #x00 #x00 #x1f #x07 #xd0 #x00 #x70 #x00 #x00 #x00
#x18 #xf8 #xf9 #xe3 #x96 #xf5 #xcb #xcf #xc6 #xdc #x80 #x7f
#x99 #x77 #x90 #x6b #x32 #xff #xf8 #x68 #x02 #x00 #x17 #xe9
#x44 #x00 #x4f #x6f #x31 #x3d #x10 #x47 #xd2 #x27 #xcb #x6d
#x09 #x08 #x31 #x45 #x2b #xdc #x28 #x22 #x22 #x80 #x57 #xa3))
(define expected-stream-info
(%make-metadata-stream-info
4096 4096 31 31 32000 1 8 24
#vu8(248 249 227 150 245 203 207 198 220 128 127 153 119 144 107 50)))
(define expected-first-frame
(%make-frame
(%make-frame-header 'fixed 24 32000 'independent 8 0 233)
22435
'((0 79 111 78 8 -61 -90 -68 -13 42 67 53 13 -27 -46 -38 -12 14 24 19 6 -4 -5 0))))
(receive (actual-metadata actual-first-frame)
(with-flac-input-port (open-bytevector-input-port example-3)
(λ ()
(flac-read/assert-magic)
(let* ((metadata (read-flac-metadata))
(stream-info (flac-metadata-stream-info metadata)))
(values
metadata
(read-flac-frame stream-info)))))
(test-group "Metadata"
(test-equal "stream info"
expected-stream-info
(flac-metadata-stream-info actual-metadata)))
(test-group "Frames"
(test-equal "frame 1" expected-first-frame actual-first-frame))))
(define exit-status (test-runner-fail-count (test-runner-current)))
(test-end "IETF Examples")
(exit (= 0 exit-status))