279 lines
11 KiB
Racket
279 lines
11 KiB
Racket
#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))
|