-
-
Notifications
You must be signed in to change notification settings - Fork 657
/
test-clark.rkt
89 lines (79 loc) · 2.31 KB
/
test-clark.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
#lang racket
(require rackunit
rackunit/text-ui
xml
racket/runtime-path)
(define (validate-xml? xml)
(error 'validate-xml? "Not implemented"))
(define (well-formed-xml? xml)
(error 'well-formed-xml? "Not implemented"))
(define (read-xml/file f)
(with-input-from-file f
(lambda () (read-xml))))
(define (dir->test-suite d name path->test-case)
(test-suite
name
(for ([p (directory-list d)]
#:when (let ([ext (filename-extension p)])
(and ext (bytes=? #"xml" ext))))
(path->test-case (build-path d p)))))
(define (not-wf-dir->test-suite d)
(define (path->test-case f)
(test-not-false
(path->string f)
(with-handlers ([exn:xml? (lambda _ #t)])
(not (well-formed-xml? (read-xml/file f))))))
(test-suite
"Not Well-Formed"
(dir->test-suite
(build-path d "sa") "Stand-alone"
path->test-case)
(dir->test-suite
(build-path d "ext-sa") "External Stand-alone"
path->test-case)
(dir->test-suite
(build-path d "not-sa") "Not Stand-alone"
path->test-case)))
(define (invalid-dir->test-suite d)
(dir->test-suite
d "Invalid"
(lambda (f)
(test-false (path->string f)
(validate-xml? (read-xml/file f))))))
; XXX also check canonical xml
(define (valid-dir->test-suite d)
(define (path->test-case f)
(test-not-false (path->string f)
(validate-xml? (read-xml/file f))))
(test-suite
"Valid"
(dir->test-suite
(build-path d "sa") "Stand-alone"
path->test-case)
(dir->test-suite
(build-path d "ext-sa") "External Stand-alone"
path->test-case)
(dir->test-suite
(build-path d "not-sa") "Not Stand-alone"
path->test-case)))
(define (directory->test-suite d)
(test-suite
"James Clark's XML Test Cases"
(not-wf-dir->test-suite (build-path d "not-wf"))
(invalid-dir->test-suite (build-path d "invalid"))
(valid-dir->test-suite (build-path d "valid"))))
(define-runtime-path
clark-tests-zip
"xmltest.zip")
(define-runtime-path
clark-tests-target
".")
(define-runtime-path
clark-tests-dir
(list 'lib "xml/xmltest" "tests"))
(require racket/system)
(system* (find-executable-path "unzip") clark-tests-zip "-d" clark-tests-target)
(define clark-tests
(directory->test-suite
clark-tests-dir))
(run-tests clark-tests)