;; 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-examples-tests mzscheme
  (provide grammar-examples-tests)
  (require "../grammar-examples.ss")
  
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 8))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 8)))
  
  (define grammar-examples-tests
    (test-suite
     "Tests for grammar examples"

     (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)))
     
     (test-false
      "Numbers aren't lambda terms."
      (lambda-calculus? 1))
      
     (test-true 
      "Variables are lambda terms."
      (lambda-calculus? 'x))
     
     (test-false
      "Malformed lambdas are not lambda terms."
      (lambda-calculus? '(lambda)))
     
     (test-false
      "Malformed lambdas are not lambda terms."
      (lambda-calculus? '(lambda ())))
     
     (test-false
      "Malformed lambdas are not lambda terms."
      (lambda-calculus? '(lambda (1) x)))
 
     (test-false
      "Malformed lambdas are not lambda terms."
      (lambda-calculus? '(lambda (x y) x)))
     
     (test-false
      "Malformed lambdas are not lambda terms."
      (lambda-calculus? '(lambda (x) x y)))
     
     (test-true
      "λx.x is a lambda terms."
      (lambda-calculus? '(lambda (x) x)))

     (test-false
      "Malformed applications are not lambda terms."
      (lambda-calculus? '()))
          
     (test-false
      "Malformed applications are not lambda terms."
      (lambda-calculus? '(x y z)))
     
     (test-true
      "Applications are lambda terms."
      (lambda-calculus? '(x y)))
     
     (test-true
      "Applications are lambda terms."
      (lambda-calculus? '((lambda (x) (x x)) (lambda (y) (y y)))))     
     
     
     ))
     
  ) ; end of module grammar-tests