(use-modules (test-suite lib) (analyzer set-queue) (analyzer lexical-envs) (analyzer value-sets) (analyzer analyze)) ;; test the set queue functions (define sq (make-set-queue)) (pass-if "set-queue-insert!" (begin (set-queue-insert! sq 1) (set-queue-insert! sq 2) (set-queue-insert! sq 3) #t)) ;; pass if you get here without an exception (pass-if "set-queue-remove" (equal? (set-queue-remove! sq) 1)) (pass-if "set-queue-remove" (equal? (set-queue-remove! sq) 2)) (pass-if "set-queue-empty?" (not (set-queue-empty? sq))) (pass-if "set-queue-remove" (equal? (set-queue-remove! sq) 3)) (pass-if "set-queue-empty?" (set-queue-empty? sq)) (pass-if "set-queue-insert!" (begin (set-queue-insert! sq 1) (set-queue-insert! sq 2) (set-queue-insert! sq 3) (set-queue-insert! sq 1) #t)) (define lst '()) (pass-if "emptying-set-queue" (begin (emptying-set-queue! sq (lambda (x) (set! lst (cons x lst)))) (equal? lst '(3 2 1)))) ;; test the environment functions (define env (make-environment)) (pass-if "lookup in empty environment" (not (environment-lookup env 'foo))) (define env-a (environment-append-pairs env (cons 'a 'b) (cons 'c 'd) (cons 'e 'f))) (pass-if "basic environment lookup" (and (eq? (environment-lookup env-a 'a) 'b) (eq? (environment-lookup env-a 'c) 'd) (eq? (environment-lookup env-a 'e) 'f))) (define env-b (environment-append-names-values env-a '(a c e) '(g h i))) (pass-if "shadowed bindings in environment" (and (eq? (environment-lookup env-b 'a) 'g) (eq? (environment-lookup env-b 'c) 'h) (eq? (environment-lookup env-b 'e) 'i))) ;; test the value set functions (define nothing (value-set-nothing)) (define anything (value-set-anything)) (define simple (value-set-with-values 1 2 3)) (define (true? x) (not (not x))) (pass-if "value-set-can-be-anything?" (value-set-can-be-anything? anything)) (pass-if "value-set-value-satisfying" (true? (value-set-value-satisfying simple number?))) (pass-if "value-set-value-satisfying" (not (value-set-value-satisfying nothing number?))) (pass-if "value-set-has-values?" (not (value-set-has-values? nothing))) (pass-if "value-set-has-values?" (value-set-has-values? anything)) (pass-if "value-set-has-values?" (value-set-has-values? simple)) (pass-if "value-set-has-value?" (true? (value-set-has-value? simple 3))) (pass-if "value-set-has-value?" (not (value-set-has-value? nothing 4))) (pass-if "value-set-has-property?" (true? (value-set-has-property? anything 'anything))) (pass-if "value-set-has-property?" (not (value-set-has-property? simple 'anything))) (pass-if "union value 4 onto other numbers" (begin (value-set-add-value! simple 4) (true? (value-set-has-value? simple 4)))) (pass-if "add property (number?)" (begin (value-set-add-property! nothing '(number?)) (true? (value-set-has-property? nothing 'number?)))) (pass-if "add property (anything), no other properties" (begin (value-set-add-property! nothing '(anything)) (not (value-set-has-property? nothing 'number?)))) (pass-if "add property (anything), no values" (begin (value-set-add-property! simple '(anything)) (not (value-set-has-value? simple 3)))) (define vs-one (value-set-with-values 1)) (define vs-two (value-set-with-values 2)) (define vs-three (value-set-with-values 3)) (define vs-four (value-set-with-values 4)) (define vs-pair (value-set-nothing)) (pass-if "union a pair value onto something without a pair value" (begin (vs-cons vs-pair vs-one vs-two) (true? (value-set-has-value? (car (value-set-value-satisfying vs-pair pair?)) 1)))) (pass-if "union a pair value onto another pair value" (begin (vs-cons vs-pair vs-three vs-four) (true? (value-set-has-value? (car (value-set-value-satisfying vs-pair pair?)) 1)))) (define vs-t1 (value-set-nothing)) (define vs-t2 (value-set-nothing)) (define vs-t3 (value-set-nothing)) (define vs-t4 (value-set-nothing)) (pass-if "take a vs-car of a pair" (begin (vs-car vs-t1 vs-pair) (true? (value-set-has-value? vs-t1 3)))) (pass-if "take a vs-car of nothing" (begin (vs-car vs-t2 (value-set-nothing)) (true? (value-set-nothing? vs-t2)))) (pass-if "take a vs-cdr of a pair" (begin (vs-cdr vs-t3 vs-pair) (true? (value-set-has-value? vs-t3 4)))) (pass-if "take a vs-cdr of nothing" (begin (vs-cdr vs-t4 (value-set-nothing)) (true? (value-set-nothing? vs-t4)))) ;; test the actual analyzer! (pass-if "(verify #f)" (not (go '(verify #f)))) (pass-if "(verify #t)" (true? (go '(verify #t)))) (pass-if "(verify #t #t #t)" (true? (go '(verify #t #t #t)))) (pass-if "(verify #t #f #t)" (not (go '(verify #t #f #t)))) (pass-if "verify outside a let" (go '(verify (let ((x #t)) x)))) (pass-if "verify inside a let" (go '(let ((x #t)) (verify x))))