(module grammar-procedures-tests mzscheme
(provide grammar-procedures-tests)
(require "../grammar-procedures.ss"
(planet "test.ss" ("schematics" "schemeunit.plt" 2 8)))
(define cfa-accepts?
(λ (x) (null? x)))
(define cfa-ok?
(λ (x) (pair? x)))
(define cfa-rejects?
(λ (x) (not x)))
(define grammar-procedures-tests
(test-suite
"Tests for grammar-procedures"
(test-pred
"True predicate rejects empty elements."
cfa-rejects?
((predicate (λ (_) #t)) '[ ]))
(test-pred
"True predicate accepts single element."
cfa-accepts?
((predicate (λ (_) #t)) '[ x ]))
(test-pred
"True predicate accepts first element of sequence."
cfa-ok?
((predicate (λ (_) #t)) '[ x y ]))
(test-pred
"False predicate rejects empty sequence."
cfa-rejects?
((predicate (λ (_) #f)) '[ ]))
(test-pred
"False predicate rejects singleton sequence."
cfa-rejects?
((predicate (λ (_) #f)) '[ x ]))
(test-pred
"False predicate rejects first element of sequence."
cfa-rejects?
((predicate (λ (_) #f)) '[ x y ]))
(test-pred
"Empty alternatives rejects empty sequence."
cfa-rejects?
((alt) '[ ]))
(test-pred
"Empty alternatives rejects singleton sequence."
cfa-rejects?
((alt) '[ x ]))
(test-pred
"Empty alternatives rejects sequence."
cfa-rejects?
((alt) '[ x y ]))
(test-pred
"Single accepting alternative rejects empty sequence."
cfa-rejects?
((alt (predicate (λ (_) #t))) '[ ]))
(test-pred
"Single accepting alternative accepts singleton sequence."
cfa-accepts?
((alt (predicate (λ (_) #t))) '[ x ]))
(test-pred
"Single accepting alternative accepts first element of sequence."
cfa-ok?
((alt (predicate (λ (_) #t))) '[ x y ]))
(test-pred
"Single rejecting alternative rejects empty sequence."
cfa-rejects?
((alt (predicate (λ (_) #f))) '[ ]))
(test-pred
"Single rejecting alternative rejects singleton sequence."
cfa-rejects?
((alt (predicate (λ (_) #f))) '[ x ]))
(test-pred
"Single rejecting alternative rejects first element of sequence."
cfa-rejects?
((alt (predicate (λ (_) #f))) '[ x y ]))
(test-pred
"Single alternative of empty alternatives rejects empty sequence."
cfa-rejects?
((alt (alt)) '[ ]))
(test-pred
"Single alternative of empty alternatives rejects singleton sequence."
cfa-rejects?
((alt (alt)) '[ x ]))
(test-pred
"Single alternative of single accepting alternative rejects empty sequence."
cfa-rejects?
((alt (alt (predicate (λ (_) #t)))) '[ ]))
(test-pred
"Single alternative of single accepting alternative accepts singleton sequence."
cfa-accepts?
((alt (alt (predicate (λ (_) #t)))) '[ x ]))
(test-pred
"Single alternative of single accepting alternative accepts first element of sequence."
cfa-ok?
((alt (alt (predicate (λ (_) #t)))) '[ x y ]))
(test-pred
"Single alternative of single rejecting alternative rejects empty sequence."
cfa-rejects?
((alt (alt (predicate (λ (_) #f)))) '[ ]))
(test-pred
"Single alternative of single rejecting alternative accepts singleton sequence."
cfa-rejects?
((alt (alt (predicate (λ (_) #f)))) '[ x ]))
(test-pred
"Empty sequence accepts empty sequence."
cfa-accepts?
((seq) '[ ]))
(test-equal?
"Empty sequence accepts empty prefix of singleton sequence."
((seq) '[ x ])
'[ x ])
(test-equal?
"Empty sequence accepts empty prefix of sequence."
((seq) '[ x y ])
'[ x y ])
(test-pred
"Single accepting sequence rejects empty sequence"
cfa-rejects?
((seq (predicate (λ (_) #t))) '[ ]))
(test-pred
"Single accepting sequence accepts singleton sequence"
cfa-accepts?
((seq (predicate (λ (_) #t))) '[ x ]))
(test-equal?
"Single accepting sequence accepts first elements of sequence"
((seq (predicate (λ (_) #t))) '[ x y ])
'[ y ])
(test-pred
"Sequence of accepting predicates accepts sequence"
cfa-accepts?
((seq (predicate (λ (_) #t)) (predicate (λ (_) #t))) '[ x y ]))
(test-pred
"Sequence of accepting predicates rejects singleton sequence"
cfa-rejects?
((seq (predicate (λ (_) #t)) (predicate (λ (_) #t))) '[ x ]))
(test-pred
"Sequence of rejecting predicates rejects singleton sequence"
cfa-rejects?
((seq (predicate (λ (_) #f)) (predicate (λ (_) #f))) '[ x ]))
(test-pred
"Empty list rejects empty sequence"
cfa-rejects?
((lst) '[ ]))
(test-pred
"Empty list rejects singleton non-list sequence"
cfa-rejects?
((lst) '[ x ]))
(test-pred
"Empty list accepts singleton empty list sequence"
cfa-accepts?
((lst) '[ () ]))
(test-pred
"Empty list rejects singleton non-empty list sequence"
cfa-rejects?
((lst) '[ (x) ]))
(test-equal?
"Empty list accepts an empty list as first element in sequence"
((lst) '[ () x ])
'[ x ])
(test-pred
"Accepting singleton list accepts singleton singleton list sequence"
cfa-accepts?
((lst (predicate (λ (_) #t))) '[ (x) ]))
(test-equal?
"Accepting singleton list accepts first singleton list element of sequence"
((lst (predicate (λ (_) #t))) '[ (x) y ])
'[ y ])
(test-pred
"Two element list rejects singleton sequence of singleton list"
cfa-rejects?
((lst (predicate (λ (_) #t)) (predicate (λ (_) #t))) '[ (x) ]))
(test-pred
"Two element list accepts singleton sequence of two element list"
cfa-accepts?
((lst (predicate (λ (_) #t)) (predicate (λ (_) #t))) '[ (x y) ]))
(test-pred
"Two element list rejects singleton sequence of three element list"
cfa-rejects?
((lst (predicate (λ (_) #t)) (predicate (λ (_) #t))) '[ (x y z) w]))
(test-pred
"Star of accepting predicate accepts empty sequence."
cfa-accepts?
((star (predicate (λ (_) #t))) '[ ]))
(test-pred
"Star of accepting predicate accepts singleton sequence."
cfa-accepts?
((star (predicate (λ (_) #t))) '[ x ]))
(test-pred
"Star of accepting predicate accepts sequence."
cfa-accepts?
((star (predicate (λ (_) #t))) '[ x y ]))
(test-pred
"Star of rejecting predicate accepts empty sequence."
cfa-accepts?
((star (predicate (λ (_) #f))) '[ ]))
(test-pred
"Star of rejecting predicate accepts empty prefix of singleton sequence."
cfa-ok?
((star (predicate (λ (_) #f))) '[ x ]))
(test-equal?
"Star of rejecting predicate accepts empty prefix of sequence."
((star (predicate (λ (_) #f))) '[ x y ])
'[ x y ])
))
)