(define-syntax test-error-message (syntax-rules () ((_ message form ...) (test-assert (guard (ex ((parse-error-object? ex) (equal? (parse-error-message ex) message)) ((error-object? ex) (equal? (error-object-message ex) message))) (begin form ... #f)))))) (test-begin "sequences") (test-error (parse "" #f)) (test-error-message "Empty input" (parse "" #f)) (test-error (parse "xxx" #f)) (test-error-message "Expected item" (parse "xxx" #f)) (test-equal '((#f (note (key . #\c)) (note (key . #\d)) (note (key . #\e)))) (parse "c d e" #f)) (test-error (parse "c d e xxx" #f)) (test-error-message "Expected item" (parse "c d e xxx" #f)) (test-error (parse "c d exxx" #f)) (test-error-message "Trailing garbage" (parse "c d exxx" #f)) (test-equal '((#f (note (key . #\c) (duration . 4) (shift . 1) (dotted . 2) (natural . #t) (octave-shift . 3)))) (parse ">>>c4+.._" #f)) (test-equal '((#f (note (key . #\c) (duration 1 1)))) (parse "c1~1" #f)) (test-error (parse "c1~1~" #f)) (test-error-message "Expected duration" (parse "c1~1~" #f)) (test-equal '((#f (chord (note (key . #\c)) (note (key . #\e)) (note (key . #\g))))) (parse "c/e/g" #f)) (test-equal '((#f (chord (note (key . #\c)) (note (key . #\e) (shift . -1)) (note (key . #\g))))) (parse "c/e-/g" #f)) (test-equal '((#f (chord (note (key . #\a)) (note (key . #\c) (octave-shift . 1)) (note (key . #\e))))) (parse "a/>c/e" #f)) (test-error (parse "c/e/" #f)) (test-error-message "Expected note" (parse "c/e/" #f)) (test-equal '((#f (rest . 4) (rest . 2) (rest . 1))) (parse "r4 r2 r1" #f)) (test-equal '((#f (rest 1 1))) (parse "r1~1" #f)) (test-equal '((#f (rest))) (parse "r" #f)) (test-error (parse "rx" #f)) (test-error-message "Invalid duration" (parse "rx" #f)) (test-error (parse "r3" #f)) (test-error-message "Invalid duration" (parse "r3" #f)) (test-equal '((#f (octave . 2) (octave . 3) (octave . 4))) (parse "o2 o3 o4" #f)) (test-error (parse "ox" #f)) (test-error-message "Invalid octave" (parse "ox" #f)) (test-equal '((#f (octave-shift . 1))) (parse ">" #f)) (test-equal '((#f (octave-shift . -1))) (parse "<" #f)) (test-equal '((#f (sexp . (volume 80)) (sexp . (tempo 120)) (sexp . (instrument 5)))) (parse "(volume 80) (tempo 120) (instrument 5)" #f)) (test-equal '((#f (chord (note (key . #\a)) (note (key . #\c)) (note (key . #\e))))) (parse "a/c/e # ignore this" #f)) (test-equal '((#f (octave . 3) (note (key . #\c) (duration . 4)) (note (key . #\d)) (note (key . #\e)) (note (key . #\f)) (note (key . #\g) (duration . 2)) (note (key . #\g)) (note (key . #\a) (duration . 4)) (note (key . #\a)) (note (key . #\a)) (note (key . #\a)) (note (key . #\g) (duration . 2)) (rest) (note (key . #\a) (duration . 4)) (note (key . #\a)) (note (key . #\a)) (note (key . #\a)) (note (key . #\g) (duration . 2)) (rest) (note (key . #\f) (duration . 4)) (note (key . #\f)) (note (key . #\f)) (note (key . #\f)) (note (key . #\e) (duration . 2)) (note (key . #\e)) (note (key . #\d) (duration . 4)) (note (key . #\d)) (note (key . #\d)) (note (key . #\d)) (note (key . #\c) (duration . 1)))) (parse "o3 c4 d e f | g2 g | a4 a a a | g2 r | a4 a a a | g2 r | f4 f f f | e2 e | d4 d d d | c1" #f)) (test-end "sequences") (test-begin "scores") (test-error (parse ": c" #t)) (test-error-message "Expected instrument" (parse ": c" #t)) (test-error (parse "piano:: c" #t)) (test-error-message "Expected nickname" (parse "piano:: c" #t)) (test-error (parse "piano:foo:bar c" #t)) (test-error-message "Expected at least one track" (parse "piano:foo:bar c" #t)) (test-error (parse "piano:foo:bar: c" #t)) (test-error-message "Trailing garbage" (parse "piano:foo:bar: c" #t)) (test-error (parse "piano: foo bar" #t)) (test-error-message "Trailing garbage" (parse "piano: foo bar" #t)) (test-equal (parse "piano: c d e " #t) '((0 (note (key . #\c)) (note (key . #\d)) (note (key . #\e))))) (let* ((linear-score "piano:main: o4 c1 d e f g a b > c piano:backing: o4 c1 < b a g f e d < c") (split-score "piano:main: o4 c1 d e f piano:backing: o4 c1 < b a g piano:main: g a b > c piano:backing: f e d < c") (nickname-score "piano:main: o4 c1 d e f g a b > c piano:backing: o4 c1 < b a g f e d < c") (split-nickname-score "piano:main: o4 c1 d e f piano:backing: o4 c1 < b a g piano:main: g a b > c piano:backing: f e d < c") (ast '((0 (octave . 4) (note (key . #\c) (duration . 1)) (note (key . #\d)) (note (key . #\e)) (note (key . #\f)) (note (key . #\g)) (note (key . #\a)) (note (key . #\b)) (octave-shift . 1) (note (key . #\c))) (0 (octave . 4) (note (key . #\c) (duration . 1)) (octave-shift . -1) (note (key . #\b)) (note (key . #\a)) (note (key . #\g)) (note (key . #\f)) (note (key . #\e)) (note (key . #\d)) (octave-shift . -1) (note (key . #\c)))))) (test-equal ast (parse linear-score #t)) (test-equal ast (parse split-score #t)) (test-equal ast (parse nickname-score #t)) (test-equal ast (parse nickname-score #t))) (test-end "scores")