hans/gemigreerd-racket-audio
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

xiph opusfile support and taglib write support.

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-07 23:49:38 +02:00
parent cf87fa7ed8
commit 4b6adc404e
8 changed files with 905 additions and 303 deletions
Download Patch File Download Diff File Expand all files Collapse all files
taglib-tests.rkt
+278
View File
@@ -0,0 +1,278 @@
#lang racket/base
(require rackunit
racket/class
racket/draw
racket/file
racket/list
racket/path
racket/runtime-path
"taglib.rkt")
(provide run-taglib-tests
run-taglib-tests/verbose
current-taglib-test-verbosity
test-audio-dir
taglib-read-files
taglib-write-files)
;; These tests expect the repository hans/racket-audio-test next to this
;; package checkout, matching the layout already used by tests.rkt:
;;
;; parent/
;; racket-audio/
;; racket-audio-test/
;;
;; The tests are defensive: missing test files are skipped, but existing files
;; are tested. Write tests always work on a temporary copy and never modify the
;; original test audio files.
(define current-taglib-test-verbosity (make-parameter 'normal))
(define (taglib-test-verbose?)
(memq (current-taglib-test-verbosity) '(verbose very-verbose)))
(define (taglib-test-note fmt . args)
(when (taglib-test-verbose?)
(apply printf fmt args)
(newline)
(flush-output)))
(define-syntax-rule (taglib-test-case name body ...)
(test-case name
(taglib-test-note "[taglib] running: ~a" name)
body ...
(taglib-test-note "[taglib] ok: ~a" name)))
(define-runtime-path test-audio-dir "../racket-audio-test")
(define taglib-read-files
'("idyll.flac"
"idyll.m4a"
"idyll.mp3"
"idyll.ogg"
"idyll.opus"
"mahler-1.mp3"
"mahler-1.ogg"
"mahler-1.opus"
"mahler-2.mp3"
"mahler-2.ogg"
"mahler-2.opus"
"ff-16b-2c-44100hz.flac"
"ff-16b-2c-44100hz.m4a"
"ff-16b-2c-44100hz.mp3"
"ff-16b-2c-44100hz.ogg"
"ff-16b-2c-44100hz.opus"))
;; Keep the write matrix deliberately small. These formats should cover the
;; main TagLib backends used by the package without making the test suite slow.
(define taglib-write-files
'("idyll.flac"
"idyll.mp3"
"idyll.m4a"
"idyll.ogg"
"idyll.opus"))
(define (existing-test-files names)
(for/list ([name (in-list names)]
#:when (file-exists? (build-path test-audio-dir name)))
(build-path test-audio-dir name)))
(define (taglib-usable?)
(with-handlers ([exn:fail? (lambda (_) #f)])
(define files (existing-test-files taglib-read-files))
(and (pair? files)
(let ([tags (id3-tags (car files))])
(and (tags-valid? tags) #t)))))
(define (copy-test-file-to-temp src)
(define dst (make-temporary-file (format "racket-audio-taglib-~a-~~a~a"
(path->string (file-name-from-path src))
(or (path-get-extension src) #""))))
(copy-file src dst #t)
dst)
(define (check-nonnegative/name name v)
(check-true (and (exact-integer? v) (>= v -1)) name))
(define (check-readable-snapshot path)
(taglib-test-case (format "read-only snapshot: ~a" (file-name-from-path path))
(define tags (id3-tags path))
(check-true (tags-valid? tags))
(check-false (tags-read-write? tags))
(check-true (tags-closed? tags))
(check-pred string? (tags-title tags))
(check-pred string? (tags-album tags))
(check-pred string? (tags-artist tags))
(check-pred string? (tags-comment tags))
(check-pred string? (tags-genre tags))
(check-nonnegative/name "year" (tags-year tags))
(check-nonnegative/name "track" (tags-track tags))
(check-nonnegative/name "length" (tags-length tags))
(check-nonnegative/name "sample-rate" (tags-sample-rate tags))
(check-nonnegative/name "bit-rate" (tags-bit-rate tags))
(check-nonnegative/name "channels" (tags-channels tags))
(check-true (list? (tags-keys tags)))
;; A read-only snapshot must still be usable after the native TagLib file
;; has been closed. This protects the audio playback path from stale file
;; handles/locks after metadata reading.
(check-pred hash? (tags->hash tags))
(check-exn exn:fail? (lambda () (tags-title! tags "must fail")))))
(define (check-call-with-closes path)
(taglib-test-case (format "call-with-id3-tags closes read-write handle: ~a" (file-name-from-path path))
(define captured #f)
(with-handlers ([exn:fail? void])
(call-with-id3-tags path #:mode 'read-write
(lambda (tags)
(set! captured tags)
(check-true (tags-read-write? tags))
(check-false (tags-closed? tags))
(error 'expected-test-exception "force close path"))))
(check-true (tags-closed? captured))))
(define (check-simple-write-roundtrip path)
(taglib-test-case (format "tag write/read/clear roundtrip: ~a" (file-name-from-path path))
(define tmp (copy-test-file-to-temp path))
(displayln (format "tmp = ~a" tmp))
(dynamic-wind
void
(lambda ()
(define title (format "Racket Audio TagLib Test ~a" (current-inexact-milliseconds)))
(call-with-id3-tags tmp #:mode 'read-write
(lambda (tags)
(check-true (tags-valid? tags))
(check-true (tags-read-write? tags))
(check-false (tags-closed? tags))
(tags-title! tags title)
(tags-album! tags "Racket Audio Test Album")
(tags-artist! tags "Racket Audio Test Artist")
(tags-comment! tags "Written by racket-audio taglib-tests.rkt")
(tags-genre! tags "Test")
(tags-year! tags 2026)
(tags-track! tags 7)
(tags-composer! tags "Racket Composer")
(tags-album-artist! tags "Racket Album Artist")
(tags-disc-number! tags 2)
(tags-set-values! tags 'performer '("Performer One" "Performer Two"))
(check-true (tags-save! tags))))
(define reread (id3-tags tmp))
(check-true (tags-valid? reread))
(check-true (tags-closed? reread))
(check-equal? (tags-title reread) title)
(check-equal? (tags-album reread) "Racket Audio Test Album")
(check-equal? (tags-artist reread) "Racket Audio Test Artist")
(check-equal? (tags-comment reread) "Written by racket-audio taglib-tests.rkt")
(check-equal? (tags-genre reread) "Test")
(check-equal? (tags-year reread) 2026)
(check-equal? (tags-track reread) 7)
(check-equal? (tags-composer reread) "Racket Composer")
(check-equal? (tags-album-artist reread) "Racket Album Artist")
(check-equal? (tags-disc-number reread) 2)
(check-equal? (tags-ref reread 'performer) '("Performer One" "Performer Two"))
(call-with-id3-tags tmp #:mode 'read-write
(lambda (tags)
(tags-title! tags 'clear)
(tags-year! tags 'clear)
(tags-track! tags 'clear)
(tags-clear! tags 'composer)
(tags-clear! tags 'performer)
(check-true (tags-save! tags))))
(define cleared (id3-tags tmp))
(check-equal? (tags-title cleared) "")
(check-equal? (tags-year cleared) -1)
(check-equal? (tags-track cleared) -1)
(check-equal? (tags-composer cleared) "")
(check-false (tags-ref cleared 'performer)))
(lambda ()
(when (file-exists? tmp) (delete-file tmp))))))
(define (make-test-bitmap)
(define bm (make-object bitmap% 4 4))
(define dc (new bitmap-dc% [bitmap bm]))
(send dc set-pen "black" 1 'solid)
(send dc set-brush "white" 'solid)
(send dc draw-rectangle 0 0 4 4)
(send dc set-pen "black" 1 'solid)
(send dc draw-line 0 0 3 3)
(send dc set-bitmap #f)
bm)
(define (check-picture-roundtrip path)
(taglib-test-case (format "picture write/read/clear roundtrip: ~a" (file-name-from-path path))
(define tmp (copy-test-file-to-temp path))
(dynamic-wind
void
(lambda ()
(define picture (make-tags-picture-from-bitmap (make-test-bitmap)
"Front Cover"
#:mimetype "image/png"
#:description "Racket test cover"))
(call-with-id3-tags tmp #:mode 'read-write
(lambda (tags)
(tags-picture! tags picture)
(check-true (tags-save! tags))))
(define reread (id3-tags tmp))
(define p (tags-picture reread))
(check-true (id3-picture? p))
(check-equal? (id3-picture-mimetype p) "image/png")
(check-equal? (id3-picture-kind p) "Front Cover")
(check-equal? (id3-picture-description p) "Racket test cover")
(check-true (> (id3-picture-size p) 0))
(check-true (is-a? (tags-picture->bitmap reread) bitmap%))
(call-with-id3-tags tmp #:mode 'read-write
(lambda (tags)
(tags-clear-picture! tags)
(check-true (tags-save! tags))))
(check-false (tags-picture (id3-tags tmp)))
)
(lambda ()
(when (file-exists? tmp) (delete-file tmp))))))
(define (run-taglib-tests [verbosity 'normal])
(unless (memq verbosity '(quiet normal verbose very-verbose))
(raise-argument-error 'run-taglib-tests "(or/c 'quiet 'normal 'verbose 'very-verbose)" verbosity))
(parameterize ([current-taglib-test-verbosity verbosity])
(cond
[(not (directory-exists? test-audio-dir))
(unless (eq? verbosity 'quiet)
(printf "Skipping TagLib tests: test audio directory not found: ~a\n" test-audio-dir))
(void)]
[(not (taglib-usable?))
(unless (eq? verbosity 'quiet)
(printf "Skipping TagLib tests: TagLib runtime is not available or no readable test file was found.\n"))
(void)]
[else
(define read-files (existing-test-files taglib-read-files))
(define write-files (existing-test-files taglib-write-files))
(taglib-test-note "[taglib] test audio directory: ~a" test-audio-dir)
(taglib-test-note "[taglib] read files: ~a" (length read-files))
(taglib-test-note "[taglib] write files: ~a" (length write-files))
(for ([path (in-list read-files)]) (check-readable-snapshot path))
(when (pair? write-files)
;; call-with close behavior only needs one writable copy.
(define tmp (copy-test-file-to-temp (car write-files)))
(dynamic-wind void
(lambda () (check-call-with-closes tmp))
(lambda () (when (file-exists? tmp) (delete-file tmp)))))
(for ([path (in-list write-files)]) (check-simple-write-roundtrip path))
;; Exercise picture writing on FLAC first, because it is the least
;; ambiguous container for embedded cover-art roundtrips with TagLib.
(define flac (build-path test-audio-dir "idyll.flac"))
(when (file-exists? flac) (check-picture-roundtrip flac))
(taglib-test-note "[taglib] done")])))
(define (run-taglib-tests/verbose)
(run-taglib-tests 'verbose))
(module+ test
(run-taglib-tests))
(module+ main
(run-taglib-tests))