tests/grammar-procedures-tests.ss
(module grammar-procedures-tests mzscheme
  (provide grammar-procedures-tests)
  
  (require "../grammar-procedures.ss"
           (planet "test.ss" ("schematics" "schemeunit.plt" 2 8)))
  
  ;; Accepts returns true iff the CFA accepts all of the input.
  (define cfa-accepts?
    (λ (x) (null? x)))
  
  ;; OK returns true iff the CFA accepts on some prefix of the input
  ;; and returns some non-empty suffix.
  
  (define cfa-ok?
    (λ (x) (pair? x)))
  
  (define cfa-rejects?
    (λ (x) (not x)))
  
  (define grammar-procedures-tests
    (test-suite
     "Tests for grammar-procedures"
 
     ;; predicate
     
     (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 ]))

     
     ;; alt
     
     (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 ]))
     
     
     ;; seq
     
     (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 ]))
     
     
     ;; lst
     
     (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]))
     
     
     ;; star
     
     (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 ])
     
     ;; opt
     ;; dot
     ;; report-if-bad
     
     ))

  ) ; end of module grammar-procedures-tests