Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-13 07:47:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added unit tests

Browse source
This commit is contained in:
Justin Ethier 2018-01-18 18:40:18 -05:00
parent bf9591c451
commit 7710bbfd9d
1 changed files with 206 additions and 172 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

376
tests/let-syntax.scm
View file

@ -1,175 +1,209 @@
(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
(let ((x 'outer)) "basic lambda bindings"
(let-syntax ((m (syntax-rules () ((m) x)))) (test 1 ((lambda (x) x) 1)))
(let ((x 'inner))
(m)))) ;; Should be outer (test-group
) "macro hygiene"
;;;; 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) (let-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
(let ((x 'outer))
(letrec-syntax ((m (syntax-rules () ((m) x))))
(let ((x 'inner))
(m)))) ;; Should be outer
)
(test
'outer
(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
)
(test
'now
(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
#;(test
7
(let ((x #f)
(y 7)
(temp 8)
(my-let odd?)
(if even?))
(or x (my-let temp) (if y) y))) ;; ==> 7
)
;; ;;;; Just testing, may want to remove this one once the recursive macro expansion works
;; ;;; (define-syntax my-or2 (syntax-rules ()
;; ;;; ((my-or2) #f)
;; ;;; ((my-or2 e) e)
;; ;;; ((my-or2 e1 e2 ...)
;; ;;; (let ((temp e1)) (if temp temp (my-or2 e2 ...))))))
;; ;;;(write (my-or2 #t))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; ;;; (define-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 ...))))))
;; ;;; (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
;; ((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
;; )
;; ;;
;;; (define-syntax my-or (syntax-rules () ;; ;;
;;; ((my-or) #f) ;; ;;;; From Chibi - isn't this a bug though?
;;; ((my-or e) e) ;; ;;;(write
;;; ((my-or e1 e2 ...) ;; ;;;(let ()
;;; (let ((temp e1)) (if temp temp (my-or e2 ...)))))) ;; ;;; (letrec-syntax ()
;;; (write ;; ;;; (define internal-def 'ok))
;;; (let ((x #f) ;; ;;; internal-def)
;;; (y 7) ;; ;;;)
;;; (temp 8)
;;; (my-let odd?) (test-group
;;; (my-if even?)) "pitfalls and corner cases"
;;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
;;; ;; ;;;; From Husk:
;;; (define-syntax foo (syntax-rules () ;; ;;;;
;;; ((_ b) ;; ;;; Examples from the source to R5RS pitfall 3.3
;;; (bar a b)))) ;; ;;;; (assert/equal
;;; (define-syntax bar (syntax-rules () ((_ c d) (test
;;; (cons c (let ((c 3)) '(1 2 3 a$273)
;;; (list d c 'c)))))) ;'(1 2 3 a)
;;; (write (let ((a 1))
;;; (let ((a 2)) (letrec-syntax
;;; (foo a))) ((foo (syntax-rules ()
;; ((_ b)
;;;; Chibi also fails with the same error when this is a let-synatx macro, (bar a b))))
;;;; so it may be that Cyclone works just fine here! Obviously it needs (bar (syntax-rules ()
;;;; to be able to handle this macro in letrec-syntax form, though ((_ c d)
;;#;(let-syntax (cons c (let ((c 3))
;; ((my-or (syntax-rules () (list d c 'c)))))))
;; ((my-or) #f) (let ((a 2))
;; ((my-or e) e) (foo a)))))
;; ((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?
;;(write
;;(letrec-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
;;)
;;
;;
;;;; 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
;;;; (assert/equal
;;;; (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))))
;;;; '(1 2 3 a))
;;;;
;;;; ; Examples from/based on pitfall 8.3 (assert/equal 1 ;;;; ; Examples from/based on pitfall 8.3 (assert/equal 1
;;;; (let ((x 1)) (test
;;;; (let-syntax ((foo (syntax-rules () ((_) 2)))) 1
;;;; (define x (foo)) (let ((x 1))
;;;; 3) (let-syntax ((foo (syntax-rules () ((_) 2))))
;;;; x)) (define x (foo))
;;;; (assert/equal 1 3)
;;;; (let ((x 1)) x))
;;;; (letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo)) (test
;;;; 3) 1
;;;; x)) (let ((x 1))
;;;; (letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo))
;;;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros 3)
;;;; (assert/equal x))
;;;; (let ((unquote 'foo)) `(,'bar))
;;;; '(,'bar)) ;;;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros
;; (test
;; '((unquote (quote bar)))
;;#;(let ((a 1)) (let ((unquote 'foo)) `(,'bar))
;; (let-syntax '(,'bar))
;; ;;(letrec-syntax )
;; ((foo (syntax-rules ()
;; ((_ b) ;; ;;
;; (bar a b)))) ;; ;;#;(let ((a 1))
;; (bar (syntax-rules () ((_ c d) ;; ;; (let-syntax
;; (cons c (let ((c 3)) ;; ;; ;;(letrec-syntax
;; (list d c 'c))))))) ;; ;; ((foo (syntax-rules ()
;; (let ((a 2)) ;; ;; ((_ b)
;; (foo a)))) ;; ;; (bar a b))))
;; ;; ;; (bar (syntax-rules () ((_ c d)
;; ;; ;; (cons c (let ((c 3))
;;(define-syntax my-let ;; ;; (list d c 'c)))))))
;; (syntax-rules ;; ;; (let ((a 2))
;; () ;; ;; (foo a))))
;; ((my-let ((name val) ...) body1 body2 ...) ;; ;;
;; ((lambda (name ...) body1 body2 ...) val ...)) ;; ;;
;; ((my-let tag ((name val) ...) body1 body2 ...) ;; ;;(define-syntax my-let
;; ((letrec ((tag (lambda (name ...) body1 body2 ...))) ;; ;; (syntax-rules
;; tag) ;; ;; ()
;; val ...)))) ;; ;; ((my-let ((name val) ...) body1 body2 ...)
;;(write ;; ;; ((lambda (name ...) body1 body2 ...) val ...))
;;(my-let ((x 'outer)) ;; ;; ((my-let tag ((name val) ...) body1 body2 ...)
;; (let-syntax ((m (syntax-rules () ((m) x)))) ;; ;; ((letrec ((tag (lambda (name ...) body1 body2 ...)))
;; (my-let ((x 'inner)) ;; ;; tag)
;; (m)))) ;; Should be outer ;; ;; val ...))))
;; ) ;; ;;(write
;; ;; ;;(my-let ((x 'outer))
;; ;; ;; (let-syntax ((m (syntax-rules () ((m) x))))
;;;; (let-syntax ((given-that (syntax-rules () ;; ;; (my-let ((x 'inner))
;;;; ((given-that test stmt1 stmt2 ...) ;; ;; (m)))) ;; Should be outer
;;;; (if test ;; ;; )
;;;; (begin stmt1 ;; ;;
;;;; stmt2 ...)))))) ;; ;;
;;;; (let ((if #t))
;;;; (given-that if (set! if 'now)) (test-exit)
;;;; 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