1;; 2;; A quick hack to run test suite written for Chibi 3;; 4 5(define-module compat.chibi-test 6 (use gauche.test) 7 (use util.match) 8 (export chibi-test current-test-comparator)) 9(select-module compat.chibi-test) 10 11(define current-test-comparator (make-parameter equal?)) 12(define-syntax gauche:parameterize parameterize) 13(define gauche:test-error test-error) 14 15;; chibi allows internal defines to interleave expressions. Gauche can't 16;; do that, so we translate the whole body of chibi-test into 17;; nested lets. 18 19;; we also cheat the scope - we want to replace macros such as 20;; test, include and parameterize, but we want them to be effective 21;; only inside chibi-test. 22 23(define-syntax chibi-test 24 (er-macro-transformer 25 (^[f r c] 26 `(let-syntax 27 ([parameterize 28 (syntax-rules () 29 [(_ bindings . fs) 30 (,(r'gauche:parameterize) bindings 31 (,(r'chibi-test:expand) fs))])] 32 [use 33 ;; NB: We ignore 'use' in the chibi test file; necessary modules 34 ;; are supposed to be already used in the includer. 35 (syntax-rules () 36 [(_ . args) (begin)])] 37 [import 38 ;; So as import 39 (syntax-rules () 40 [(_ . args) (begin)])] 41 [include 42 (syntax-rules () 43 [(_ file) (,(r'chibi-test:include) file)])] 44 [test 45 (syntax-rules () 46 [(_ name expected expr) 47 (,(r'test*) name expected expr (current-test-comparator))] 48 [(_ expected expr) 49 (,(r'test*) 'expr expected expr (current-test-comparator))])] 50 [test-group 51 (syntax-rules () 52 [(_ name . fs) 53 (begin 54 (,(r'test-section) name) 55 (,(r'chibi-test:expand) fs))])] 56 [test-assert 57 (syntax-rules () 58 [(_ expr) 59 (,(r'test*) 'expr #t (,(r'boolean) expr))] 60 [(_ name expr) 61 (,(r'test*) name #t (,(r'boolean) expr))])] 62 [test-not 63 (syntax-rules () 64 [(_ expr) 65 (,(r'test*) 'expr #f (,(r'boolean) expr))] 66 [(_ name expr) 67 (,(r'test*) name #f (,(r'boolean) expr))])] 68 [test-error 69 (syntax-rules () 70 [(_ expr) 71 (,(r'test*) 'expr (,(r'gauche:test-error)) expr)])] 72 [test-exit 73 ;; ignore test-exit, for it is inside chibi-test and we don't 74 ;; want to exit. 75 (syntax-rules () 76 [(_ . args) (begin)])] 77 ) 78 (,(r'chibi-test:expand) ,(cdr f)))))) 79 80;; We gather definitions at the same level, so that mutually recursive 81;; definitions work 82(define-syntax chibi-test:expand 83 (er-macro-transformer 84 (^[f r c] 85 (let loop ([forms (cadr f)] 86 [defs '()]) 87 (match forms 88 [() 89 (if (null? defs) 90 (quasirename r `(begin)) 91 (quasirename r `(let () ,@(reverse defs) (begin))))] 92 [(form) 93 (if (null? defs) 94 (car forms) 95 (quasirename r `(let () ,@(reverse defs) ,(car forms))))] 96 [((and ((? (cut c <> (r'define))) . _) def) . forms) 97 (loop forms (cons def defs))] 98 [(form . forms) 99 (if (null? defs) 100 (quasirename r `(let () ,form (chibi-test:expand ,forms))) 101 (quasirename r `(let () ,@(reverse defs) 102 ,form (chibi-test:expand ,forms))))]))))) 103 104(define-syntax chibi-test:include 105 (er-macro-transformer 106 (^[f r c] 107 (let ([file (cadr f)]) 108 (let1 iport ((with-module gauche.internal pass1/open-include-file) 109 file (current-load-path)) 110 (unwind-protect 111 `(,(r 'chibi-test:expand) ,(port->sexp-list iport)) 112 (close-port iport))))))) 113 114;; A hack to make Gauche think it has loaded chibi.test so that it won't 115;; tripped by (import (chibi test)) in the test code. 116(define-module chibi.test (extend compat.chibi-test)) 117(provide "chibi/test") 118(provide "compat/chibi-test") 119