~ chicken-core (chicken-5) /tests/environment-tests.scm

 1;;;; environment-tests.scm
 2
 3(import (chicken load) (chicken eval))
 4
 5(load-relative "test.scm")
 6
 7
 8(test-begin "evaluation environment tests")
 9
10(test-equal (eval 123) 123)
11(test-equal (eval 123 (interaction-environment)) 123)
12(test-equal (eval 'car (interaction-environment)) car)
13(test-error (eval 'foo (interaction-environment)))
14(test-equal (eval '(begin (set! foo 99) foo) (interaction-environment)) 99)
15
16(test-equal (eval 123) 123)
17(test-equal (eval 123 (scheme-report-environment 5)) 123)
18(test-equal (eval 'car (scheme-report-environment 5)) car)
19(test-error (eval 'foo (scheme-report-environment 5)))
20(test-error (eval 'values (scheme-report-environment 4)))
21(test-equal (eval 'values (scheme-report-environment 5)) values)
22(test-error (eval '(set! foo 99) (scheme-report-environment 5)))
23
24(test-error (eval '(define-syntax foo (syntax-rules () ((_) 1)))
25		  (scheme-report-environment 5)))
26
27(test-error (eval 'car (null-environment 5)))
28(test-error (eval '(cond-expand (chicken 1) (else 2)) (null-environment 4)))
29(test-error (eval '(cond-expand (chicken 1) (else 2)) (null-environment 5)))
30(test-error (eval '(cond-expand (chicken 1) (else 2)) (scheme-report-environment 4)))
31(test-error (eval '(cond-expand (chicken 1) (else 2)) (scheme-report-environment 5)))
32(test-equal 1 (eval '(if #t 1 2) (scheme-report-environment 5)))
33(test-equal 1 (eval '(if #t 1 2) (null-environment 4)))
34(test-equal 1 (eval '(if #t 1 2) (null-environment 5)))
35(test-equal (eval '((lambda (x) x) 123) (null-environment 5)) 123)
36
37(import (chicken eval))
38
39(define baz 100)
40
41(module foo (bar)
42  (import r5rs)
43  (define (bar) 99))
44
45(define foo-env (module-environment 'foo))
46(define csi-env (module-environment '(chicken csi)))
47(define format-env (module-environment 'chicken.format))
48
49(test-equal (eval '(bar) foo-env) 99)
50(test-error (eval 'baz foo-env))
51(test-equal (eval '(editor-command) csi-env) #f)
52(test-error (eval 'baz csi-env))
53(test-equal (eval '(format "~a" 1) format-env) "1")
54(test-error (eval 'baz format-env))
55
56;; #1295
57(module example *
58  (import scheme)
59  (define (add a b) (+ a b))
60  (define-syntax double
61    (syntax-rules ()
62      ((_ x) (add x x)))))
63
64(test-equal (eval '(double 10) (module-environment 'example)) 20)
65
66(test-end)
67
68(test-exit)