mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-13 07:47:39 +02:00
Added unit tests
This commit is contained in:
Justin Ethier
parent
bf9591c451
commit
7710bbfd9d
1 changed files with 206 additions and 172 deletions
|
|
@ -1,65 +1,112 @@
|
||||||
(import (scheme base) (scheme write) (scheme cyclone pretty-print))
|
(import
|
||||||
|
(scheme base)
|
||||||
|
(scheme write)
|
||||||
|
(scheme cyclone test)
|
||||||
|
(scheme cyclone pretty-print))
|
||||||
|
|
||||||
(write
|
(define (output sexp)
|
||||||
((lambda (x) x) 1))
|
(write sexp)
|
||||||
|
(newline))
|
||||||
|
|
||||||
(write
|
(test-group
|
||||||
|
"basic lambda bindings"
|
||||||
|
(test 1 ((lambda (x) x) 1)))
|
||||||
|
|
||||||
|
(test-group
|
||||||
|
"macro hygiene"
|
||||||
|
(test
|
||||||
|
'outer
|
||||||
(let ((x 'outer))
|
(let ((x 'outer))
|
||||||
(let-syntax ((m (syntax-rules () ((m) x))))
|
(let-syntax ((m (syntax-rules () ((m) x))))
|
||||||
(let ((x 'inner))
|
(let ((x 'inner))
|
||||||
(m)))) ;; Should be outer
|
(m)))) ;; Should be outer
|
||||||
)
|
)
|
||||||
;;;; Just testing, may want to remove this one once the recursive macro expansion works
|
(test
|
||||||
;;; (define-syntax my-or2 (syntax-rules ()
|
'outer
|
||||||
;;; ((my-or2) #f)
|
(let ((x 'outer))
|
||||||
;;; ((my-or2 e) e)
|
(letrec-syntax ((m (syntax-rules () ((m) x))))
|
||||||
;;; ((my-or2 e1 e2 ...)
|
(let ((x 'inner))
|
||||||
;;; (let ((temp e1)) (if temp temp (my-or2 e2 ...))))))
|
(m)))) ;; Should be outer
|
||||||
;;;(write (my-or2 #t))
|
)
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
(test
|
||||||
;;
|
'outer
|
||||||
;;; (define-syntax my-or (syntax-rules ()
|
(let ((x 'outer))
|
||||||
;;; ((my-or) #f)
|
(define-syntax m ;; Testing this out, but let-syntax needs to work, too
|
||||||
;;; ((my-or e) e)
|
(syntax-rules () ((m) x)))
|
||||||
;;; ((my-or e1 e2 ...)
|
(let ((x 'inner))
|
||||||
;;; (let ((temp e1)) (if temp temp (my-or e2 ...))))))
|
(m))) ;; Should be outer
|
||||||
;;; (write
|
)
|
||||||
;;; (let ((x #f)
|
(test
|
||||||
;;; (y 7)
|
'now
|
||||||
;;; (temp 8)
|
(let-syntax ((given-that (syntax-rules ()
|
||||||
;;; (my-let odd?)
|
((given-that test stmt1 stmt2 ...)
|
||||||
;;; (my-if even?))
|
(if test
|
||||||
;;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
(begin stmt1
|
||||||
;;;
|
stmt2 ...))))))
|
||||||
;;; (define-syntax foo (syntax-rules ()
|
(let ((if #t))
|
||||||
;;; ((_ b)
|
(given-that if (set! if 'now))
|
||||||
;;; (bar a b))))
|
if))) ;; => now
|
||||||
;;; (define-syntax bar (syntax-rules () ((_ c d)
|
#;(test
|
||||||
;;; (cons c (let ((c 3))
|
7
|
||||||
;;; (list d c 'c))))))
|
(let ((x #f)
|
||||||
;;; (write
|
(y 7)
|
||||||
;;; (let ((a 2))
|
(temp 8)
|
||||||
;;; (foo a)))
|
(my-let odd?)
|
||||||
;;
|
(if even?))
|
||||||
;;;; Chibi also fails with the same error when this is a let-synatx macro,
|
(or x (my-let temp) (if y) y))) ;; ==> 7
|
||||||
;;;; so it may be that Cyclone works just fine here! Obviously it needs
|
)
|
||||||
;;;; to be able to handle this macro in letrec-syntax form, though
|
|
||||||
;;#;(let-syntax
|
;; ;;;; Just testing, may want to remove this one once the recursive macro expansion works
|
||||||
;; ((my-or (syntax-rules ()
|
;; ;;; (define-syntax my-or2 (syntax-rules ()
|
||||||
;; ((my-or) #f)
|
;; ;;; ((my-or2) #f)
|
||||||
;; ((my-or e) e)
|
;; ;;; ((my-or2 e) e)
|
||||||
;; ((my-or e1 e2 ...)
|
;; ;;; ((my-or2 e1 e2 ...)
|
||||||
;; (let ((temp e1)) (if temp temp (my-or e2 ...)))))))
|
;; ;;; (let ((temp e1)) (if temp temp (my-or2 e2 ...))))))
|
||||||
;; (let ((x #f)
|
;; ;;;(write (my-or2 #t))
|
||||||
;; (y 7)
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; (temp 8)
|
;; ;;
|
||||||
;; (my-let odd?)
|
;; ;;; (define-syntax my-or (syntax-rules ()
|
||||||
;; (my-if even?))
|
;; ;;; ((my-or) #f)
|
||||||
;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
;; ;;; ((my-or e) e)
|
||||||
;;
|
;; ;;; ((my-or e1 e2 ...)
|
||||||
;;;; TODO: below should work with "let" and "if" instead of "my-let" and "my-if"
|
;; ;;; (let ((temp e1)) (if temp temp (my-or e2 ...))))))
|
||||||
;;;; TODO: below does not work in eval - WTF?
|
;; ;;; (write
|
||||||
;;(write
|
;; ;;; (let ((x #f)
|
||||||
|
;; ;;; (y 7)
|
||||||
|
;; ;;; (temp 8)
|
||||||
|
;; ;;; (my-let odd?)
|
||||||
|
;; ;;; (my-if even?))
|
||||||
|
;; ;;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||||
|
;; ;;;
|
||||||
|
;; ;;; (define-syntax foo (syntax-rules ()
|
||||||
|
;; ;;; ((_ b)
|
||||||
|
;; ;;; (bar a b))))
|
||||||
|
;; ;;; (define-syntax bar (syntax-rules () ((_ c d)
|
||||||
|
;; ;;; (cons c (let ((c 3))
|
||||||
|
;; ;;; (list d c 'c))))))
|
||||||
|
;; ;;; (write
|
||||||
|
;; ;;; (let ((a 2))
|
||||||
|
;; ;;; (foo a)))
|
||||||
|
;; ;;
|
||||||
|
;; ;;;; Chibi also fails with the same error when this is a let-synatx macro,
|
||||||
|
;; ;;;; so it may be that Cyclone works just fine here! Obviously it needs
|
||||||
|
;; ;;;; to be able to handle this macro in letrec-syntax form, though
|
||||||
|
;; ;;#;(let-syntax
|
||||||
|
;; ;; ((my-or (syntax-rules ()
|
||||||
|
;; ;; ((my-or) #f)
|
||||||
|
;; ;; ((my-or e) e)
|
||||||
|
;; ;; ((my-or e1 e2 ...)
|
||||||
|
;; ;; (let ((temp e1)) (if temp temp (my-or e2 ...)))))))
|
||||||
|
;; ;; (let ((x #f)
|
||||||
|
;; ;; (y 7)
|
||||||
|
;; ;; (temp 8)
|
||||||
|
;; ;; (my-let odd?)
|
||||||
|
;; ;; (my-if even?))
|
||||||
|
;; ;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||||
|
;; ;;
|
||||||
|
;; ;;;; TODO: below should work with "let" and "if" instead of "my-let" and "my-if"
|
||||||
|
;; ;;;; TODO: below does not work in eval - WTF?
|
||||||
|
;; (output
|
||||||
;; (letrec-syntax
|
;; (letrec-syntax
|
||||||
;; ((my-or (syntax-rules ()
|
;; ((my-or (syntax-rules ()
|
||||||
;; ((my-or) #f)
|
;; ((my-or) #f)
|
||||||
|
|
@ -74,102 +121,89 @@
|
||||||
;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||||
;; )
|
;; )
|
||||||
;;
|
;;
|
||||||
;;
|
|
||||||
;;;; From Chibi - isn't this a bug though?
|
|
||||||
;;;(write
|
|
||||||
;;;(let ()
|
|
||||||
;;; (letrec-syntax ()
|
|
||||||
;;; (define internal-def 'ok))
|
|
||||||
;;; internal-def)
|
|
||||||
;;;)
|
|
||||||
;;
|
|
||||||
;;;; From Husk:
|
|
||||||
;; ;;
|
;; ;;
|
||||||
;;; Examples from the source to R5RS pitfall 3.3
|
;; ;;;; From Chibi - isn't this a bug though?
|
||||||
;;;; (assert/equal
|
;; ;;;(write
|
||||||
;;;; (let ((a 1))
|
;; ;;;(let ()
|
||||||
;;;; (letrec-syntax
|
;; ;;; (letrec-syntax ()
|
||||||
|
;; ;;; (define internal-def 'ok))
|
||||||
|
;; ;;; internal-def)
|
||||||
|
;; ;;;)
|
||||||
|
|
||||||
|
(test-group
|
||||||
|
"pitfalls and corner cases"
|
||||||
|
|
||||||
|
;; ;;;; From Husk:
|
||||||
|
;; ;;;;
|
||||||
|
;; ;;; Examples from the source to R5RS pitfall 3.3
|
||||||
|
;; ;;;; (assert/equal
|
||||||
|
(test
|
||||||
|
'(1 2 3 a$273)
|
||||||
|
;'(1 2 3 a)
|
||||||
|
(let ((a 1))
|
||||||
|
(letrec-syntax
|
||||||
|
((foo (syntax-rules ()
|
||||||
|
((_ b)
|
||||||
|
(bar a b))))
|
||||||
|
(bar (syntax-rules ()
|
||||||
|
((_ c d)
|
||||||
|
(cons c (let ((c 3))
|
||||||
|
(list d c 'c)))))))
|
||||||
|
(let ((a 2))
|
||||||
|
(foo a)))))
|
||||||
|
|
||||||
|
;;;; ; Examples from/based on pitfall 8.3 (assert/equal 1
|
||||||
|
(test
|
||||||
|
1
|
||||||
|
(let ((x 1))
|
||||||
|
(let-syntax ((foo (syntax-rules () ((_) 2))))
|
||||||
|
(define x (foo))
|
||||||
|
3)
|
||||||
|
x))
|
||||||
|
(test
|
||||||
|
1
|
||||||
|
(let ((x 1))
|
||||||
|
(letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo))
|
||||||
|
3)
|
||||||
|
x))
|
||||||
|
|
||||||
|
;;;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros
|
||||||
|
(test
|
||||||
|
'((unquote (quote bar)))
|
||||||
|
(let ((unquote 'foo)) `(,'bar))
|
||||||
|
'(,'bar))
|
||||||
|
)
|
||||||
|
|
||||||
|
;; ;;
|
||||||
|
;; ;;#;(let ((a 1))
|
||||||
|
;; ;; (let-syntax
|
||||||
|
;; ;; ;;(letrec-syntax
|
||||||
;; ;; ((foo (syntax-rules ()
|
;; ;; ((foo (syntax-rules ()
|
||||||
;; ;; ((_ b)
|
;; ;; ((_ b)
|
||||||
;; ;; (bar a b))))
|
;; ;; (bar a b))))
|
||||||
;;;; (bar (syntax-rules ()
|
;; ;; (bar (syntax-rules () ((_ c d)
|
||||||
;;;; ((_ c d)
|
|
||||||
;; ;; (cons c (let ((c 3))
|
;; ;; (cons c (let ((c 3))
|
||||||
;; ;; (list d c 'c)))))))
|
;; ;; (list d c 'c)))))))
|
||||||
;; ;; (let ((a 2))
|
;; ;; (let ((a 2))
|
||||||
;; ;; (foo a))))
|
;; ;; (foo a))))
|
||||||
;;;; '(1 2 3 a))
|
|
||||||
;; ;;
|
;; ;;
|
||||||
;;;; ; Examples from/based on pitfall 8.3 (assert/equal 1
|
|
||||||
;;;; (let ((x 1))
|
|
||||||
;;;; (let-syntax ((foo (syntax-rules () ((_) 2))))
|
|
||||||
;;;; (define x (foo))
|
|
||||||
;;;; 3)
|
|
||||||
;;;; x))
|
|
||||||
;;;; (assert/equal 1
|
|
||||||
;;;; (let ((x 1))
|
|
||||||
;;;; (letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo))
|
|
||||||
;;;; 3)
|
|
||||||
;;;; x))
|
|
||||||
;; ;;
|
;; ;;
|
||||||
;;;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros
|
;; ;;(define-syntax my-let
|
||||||
;;;; (assert/equal
|
;; ;; (syntax-rules
|
||||||
;;;; (let ((unquote 'foo)) `(,'bar))
|
;; ;; ()
|
||||||
;;;; '(,'bar))
|
;; ;; ((my-let ((name val) ...) body1 body2 ...)
|
||||||
;;
|
;; ;; ((lambda (name ...) body1 body2 ...) val ...))
|
||||||
;;
|
;; ;; ((my-let tag ((name val) ...) body1 body2 ...)
|
||||||
;;#;(let ((a 1))
|
;; ;; ((letrec ((tag (lambda (name ...) body1 body2 ...)))
|
||||||
;; (let-syntax
|
;; ;; tag)
|
||||||
;; ;;(letrec-syntax
|
;; ;; val ...))))
|
||||||
;; ((foo (syntax-rules ()
|
;; ;;(write
|
||||||
;; ((_ b)
|
;; ;;(my-let ((x 'outer))
|
||||||
;; (bar a b))))
|
;; ;; (let-syntax ((m (syntax-rules () ((m) x))))
|
||||||
;; (bar (syntax-rules () ((_ c d)
|
;; ;; (my-let ((x 'inner))
|
||||||
;; (cons c (let ((c 3))
|
;; ;; (m)))) ;; Should be outer
|
||||||
;; (list d c 'c)))))))
|
;; ;; )
|
||||||
;; (let ((a 2))
|
;; ;;
|
||||||
;; (foo a))))
|
;; ;;
|
||||||
;;
|
|
||||||
;;
|
(test-exit)
|
||||||
;;(define-syntax my-let
|
|
||||||
;; (syntax-rules
|
|
||||||
;; ()
|
|
||||||
;; ((my-let ((name val) ...) body1 body2 ...)
|
|
||||||
;; ((lambda (name ...) body1 body2 ...) val ...))
|
|
||||||
;; ((my-let tag ((name val) ...) body1 body2 ...)
|
|
||||||
;; ((letrec ((tag (lambda (name ...) body1 body2 ...)))
|
|
||||||
;; tag)
|
|
||||||
;; val ...))))
|
|
||||||
;;(write
|
|
||||||
;;(my-let ((x 'outer))
|
|
||||||
;; (let-syntax ((m (syntax-rules () ((m) x))))
|
|
||||||
;; (my-let ((x 'inner))
|
|
||||||
;; (m)))) ;; Should be outer
|
|
||||||
;; )
|
|
||||||
;;
|
|
||||||
;;
|
|
||||||
;;;; (let-syntax ((given-that (syntax-rules ()
|
|
||||||
;;;; ((given-that test stmt1 stmt2 ...)
|
|
||||||
;;;; (if test
|
|
||||||
;;;; (begin stmt1
|
|
||||||
;;;; stmt2 ...))))))
|
|
||||||
;;;; (let ((if #t))
|
|
||||||
;;;; (given-that if (set! if 'now))
|
|
||||||
;;;; if)) ;; => now
|
|
||||||
;;
|
|
||||||
;;(write
|
|
||||||
;;(let ((x 'outer))
|
|
||||||
;; (let-syntax ((m (syntax-rules () ((m) x))))
|
|
||||||
;; (let ((x 'inner))
|
|
||||||
;; (m)))) ;; Should be outer
|
|
||||||
;; )
|
|
||||||
;;
|
|
||||||
;;;(write
|
|
||||||
;;;(let ((x 'outer))
|
|
||||||
;;; (define-syntax m ;; Testing this out, but let-syntax needs to work, too
|
|
||||||
;;; (syntax-rules () ((m) x)))
|
|
||||||
;;; (let ((x 'inner))
|
|
||||||
;;; (m))) ;; Should be outer
|
|
||||||
;;; )
|
|
||||||
;;;
|
|
||||||
;;;(write (m)) ;; Should be an error, of course
|
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue