84 lines
2.8 KiB
Scheme
84 lines
2.8 KiB
Scheme
|
|
(require mzlib/string
|
|
(only-in net/url get-pure-port string->url)
|
|
(only-in mzlib/port copy-port))
|
|
|
|
(load-relative "loadtest.ss")
|
|
|
|
(Section 'uni-norm)
|
|
|
|
(define (parse-string m)
|
|
(let ([s (regexp-split #rx" +" m)])
|
|
(apply string
|
|
(map (lambda (x)
|
|
(integer->char (string->number (bytes->string/latin-1 x) 16)))
|
|
s))))
|
|
|
|
(define (get-test-file)
|
|
(define name "NormalizationTest.txt")
|
|
(define base "http://www.unicode.org/Public/5.0.0/ucd/")
|
|
(define (existing)
|
|
(let loop ([dirs (list (current-load-relative-directory)
|
|
(current-directory))])
|
|
(and (pair? dirs)
|
|
(let ([path (build-path (car dirs) name)])
|
|
(if (file-exists? path) path (loop (cdr dirs)))))))
|
|
(define (get-it)
|
|
(parameterize ([current-input-port
|
|
(get-pure-port (string->url (string-append base name)))])
|
|
(with-output-to-file name
|
|
(lambda () (copy-port (current-input-port) (current-output-port)))
|
|
#:exists 'truncate)))
|
|
(or (existing)
|
|
(begin (get-it) (existing))
|
|
(error "file not found: ~s" (string-append base name))))
|
|
|
|
(printf "Reading tests...\n")
|
|
(define test-strings
|
|
(with-input-from-file (get-test-file)
|
|
(lambda ()
|
|
(unless (regexp-match #rx"^# NormalizationTest-" (read-line))
|
|
(error "Bad test-file contents (couldn't retreive tests?)"))
|
|
(let loop ([a null])
|
|
(let ([l (read-line)])
|
|
(if (eof-object? l)
|
|
(if (null? a)
|
|
(error "No tests found (couldn't retreive tests?)")
|
|
(reverse a))
|
|
(let ([m (regexp-match #rx#"^([0-9A-F ]+);([0-9A-F ]+);([0-9A-F ]+);([0-9A-F ]+);([0-9A-F ]+)" l)])
|
|
(if m
|
|
(loop (cons (cons l (map parse-string (cdr m))) a))
|
|
(loop a)))))))))
|
|
|
|
|
|
(for-each (lambda (l)
|
|
(let-values ([(t c1 c2 c3 c4 c5) (apply values l)])
|
|
(printf "Checking ~a\n" t)
|
|
|
|
(test c2 string-normalize-nfc c1)
|
|
(test c2 string-normalize-nfc c2)
|
|
(test c2 string-normalize-nfc c3)
|
|
(test c4 string-normalize-nfc c4)
|
|
(test c4 string-normalize-nfc c5)
|
|
|
|
(test c3 string-normalize-nfd c1)
|
|
(test c3 string-normalize-nfd c2)
|
|
(test c3 string-normalize-nfd c3)
|
|
(test c5 string-normalize-nfd c4)
|
|
(test c5 string-normalize-nfd c5)
|
|
|
|
(test c4 string-normalize-nfkc c1)
|
|
(test c4 string-normalize-nfkc c2)
|
|
(test c4 string-normalize-nfkc c3)
|
|
(test c4 string-normalize-nfkc c4)
|
|
(test c4 string-normalize-nfkc c5)
|
|
|
|
(test c5 string-normalize-nfkd c1)
|
|
(test c5 string-normalize-nfkd c2)
|
|
(test c5 string-normalize-nfkd c3)
|
|
(test c5 string-normalize-nfkd c4)
|
|
(test c5 string-normalize-nfkd c5)))
|
|
test-strings)
|
|
|
|
(report-errs)
|