;; To run the tests:
;;
;;   (require (planet "tests/grammar-tests.ss" ("dvanhorn" "grammar.plt" 1 0))
;;            (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 8)))
;;   (test/text-ui grammar-tests)

(module grammar-tests mzscheme
  (provide grammar-tests)
  (require "../grammar-examples.ss")
  
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 8)))
  
  (define grammar-tests
    (test-suite
     "Tests for grammar"

     (test-true
      "Accepted EOPL 5.5 expression"
      (eopl-section-5.5-exp?
       '(let ((a 3)) (if (zero? a) 1 2))))
     
     (test-false
      "Rejected EOPL 5.5 expression"
      (eopl-section-5.5-exp?
       '(let ((a 3)) if (zero? a) 1 2)))
     
     (test-true
      "Accepted grammar expression"
      (grammar?
       '(grammar expression
          (variable
           (predicate
            (lambda (x)
              (and (symbol? x)
                   (not (memq x '(quote if lambda let set!)))))))
          (literal (predicate number?))
          (datum (predicate (lambda (x) #t)))
          (declaration (lst variable expression))
          (procedure-call
           (predicate;; this could have been (lst (plus expression))
            (lambda (x);; but then a spurious bad keyword is reported
              (and (pair? x)	    
                   (not (and (symbol? (car x)) (not (variable x))))
                   (not (boolean? ((plus expression) x)))))))
          (expression
           (report-if-bad 'expression
                          (alt variable literal procedure-call
                               (lst 'quote datum)
                               (lst 'lambda (lst (star variable)) expression)
                               (lst 'if expression expression expression)
                               (lst 'set! variable expression)
                               (lst 'let (lst (star declaration)) expression)))))))
     
     (test-false
      "Rejected grammar expression"
      (grammar?
       '(grammar)))
     
     (test-true
      "Accepted R4RS Scheme expression"
      (r4rs-scheme?
       '(lambda (x) x)))
     
     (test-false
      "Rejected R4RS Scheme expression"
      (r4rs-scheme?
       '(lambda)))
     
     ))
     
  ) ; end of module grammar-tests