;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; environment-tests
;; Richard Cobbe
;;
;; tests for the environment module.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module environment-tests mzscheme

  (require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
           "environment.ss")

  (define environment-tests
   (make-test-suite
    "Tests for basic environments"

    (make-test-case
     "lookup-in-empty"
     (assert = 3 (lookup (make-empty-env) 'x eq? (lambda () 3))))

    (make-test-case
     "id present"
     (assert = 42 (lookup (extend-env (make-empty-env)
                                      '(x y z)
                                      '(16 42 53))
                          'y)))
    (make-test-case
     "id not present"
     (assert = 0 (lookup (extend-env (make-empty-env) '(a b c) '(1 2 3))
                         'x
                         eq?
                         (lambda () 0))))

    (make-test-case
     "id, fk not present"
     (assert-exn (lambda (exn)
                   (and (exn:env:unbound? exn)
                        (string=? "lookup: unbound ID" (exn-message exn))
                        (eq? 'bogus (exn:env:unbound-id exn))))
                 (lambda () (lookup (extend-env (make-empty-env)
                                                '(a b c) '(1 2 3))
                                    'bogus))))

    (make-test-case "env->alist"
                    (assert-equal? (env->alist
                                    (extend-env (extend-env (make-empty-env)
                                                            '(x y)
                                                            '(1 2))
                                                '(a b x)
                                                '(4 5 6)))
                                   '((a 4) (b 5) (x 6) (x 1) (y 2))))

    (make-test-case "extend: mismatch"
      (assert-exn exn:fail?
       (lambda () (extend-env (make-empty-env) '(a b c) '(3 4)))))

    (make-test-case "lookup with non-symbol key"
      (assert = 17 (lookup (extend-env (make-empty-env) '((a b)) '(17))
                           '(a b)
                           equal?)))

    (make-test-case "lookup with missing non-symbol key"
      (assert-exn exn:env:unbound?
                  (lambda () (lookup (extend-env (make-empty-env)
                                                 '((a b))
                                                 '(17))
                                     '(c d)
                                     equal?))))

    (make-test-case "env macro"
      (assert = 17 (lookup (env [(a b) 17]) '(a b) equal?)))

    (make-test-case "env macro: failed"
      (assert-exn exn:env:unbound?
                  (lambda () (lookup (env [(a b) 17]) '(c d) equal?)))))))