~ chicken-core (chicken-5) /tests/user-pass-tests.scm

 1;;; Test user compilation passes
 2
 3(import (chicken base)
 4        (chicken compiler user-pass)
 5        (chicken io)
 6        (chicken pretty-print))
 7
 8(define passes '()) ; track user passes
 9
10(user-read-pass
11 (lambda (_ _ _)
12   (set! passes (cons 'user-read-pass passes))
13   (list 'ok))) ; ignore file and use single datum
14
15(user-preprocessor-pass
16 (lambda (x)
17   (set! passes (cons 'user-preprocessor-pass passes))
18   (values x)))
19
20(user-pass
21 (lambda (x)
22   (set! passes (cons 'user-pass passes))
23   (values x)))
24
25(user-post-analysis-pass
26 (lambda (_ _ _ _ _ _ _)
27   (set! passes (cons 'user-post-analysis-pass passes))))
28
29(on-exit
30 (lambda ()
31   (assert (memq 'user-read-pass passes)          "user-read-pass not called")
32   (assert (memq 'user-pass passes)               "user-pass not called")
33   (assert (memq 'user-preprocessor-pass passes)  "user-preprocessor-pass not called")
34   (assert (memq 'user-post-analysis-pass passes) "user-post-analysis-pass not called")))