Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add identifier macro tests to syntax-test.scm

Browse source
This commit is contained in:
Daphne Preston-Kendal 2022-02-04 11:28:31 +01:00
parent 920ba20a8c
commit abda243d21
1 changed files with 75 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

76
tests/syntax-tests.scm
View file

@ -1,6 +1,9 @@
(cond-expand
(modules (import (chibi) (only (chibi test) test-begin test test-end)))
(modules
(import (chibi)
(only (chibi test) test-begin test test-error test-end)
(only (meta) environment)))
(else #f))
(test-begin "syntax")
@ -75,3 +78,74 @@
(test '(2 1) (asd 1 2)))
(test-end)
(cond-expand
;; can only test identifier-syntax with access to modules (though
;; this could be fixed in theory)
(modules
(test-begin "identifier syntax")
(define syntax-test-env (environment '(chibi)))
(eval
'(define-syntax low-level-id-macro
(er-macro-transformer*
(lambda (expr rename compare)
(if (pair? expr)
(list (rename 'quote) 'operator)
(list (rename 'quote) 'operand)))))
syntax-test-env)
(test 'operator (eval '(low-level-id-macro) syntax-test-env))
(test 'operand (eval 'low-level-id-macro syntax-test-env))
(test-error (eval '(set! low-level-id-macro 'foo) syntax-test-env))
(eval
'(define-syntax low-level-vt
(make-variable-transformer
(er-macro-transformer*
(lambda (expr rename compare)
(list (rename 'quote)
(if (pair? expr)
(if (compare (car expr) (rename 'set!))
'set
'app)
'ref))))))
syntax-test-env)
(test 'set (eval '(set! low-level-vt 'foo) syntax-test-env))
(test 'app (eval '(low-level-vt) syntax-test-env))
(test 'ref (eval 'low-level-vt syntax-test-env))
(eval '(define p (cons 1 2)) syntax-test-env)
(eval '(define-syntax p.car (identifier-syntax (car p))) syntax-test-env)
(eval
'(define-syntax p.cdr
(identifier-syntax
(_ (cdr p))
((set! _ v) (set-cdr! p v))))
syntax-test-env)
(test 1 (eval 'p.car syntax-test-env))
(test-error (eval '(set! p.car 0) syntax-test-env))
(test 2 (eval 'p.cdr syntax-test-env))
(test 3 (eval
'(begin
(set! p.cdr 3)
(cdr p))
syntax-test-env))
;; weirdnesses: syntax that refers to its own name and uses ellipsis
(eval
'(define-syntax sr-id-macro
(identifier-syntax
(name 'name)
((set! name (val ...)) (cons 'name '(val ...)))))
syntax-test-env)
(test 'sr-id-macro (eval 'sr-id-macro syntax-test-env))
(test '(sr-id-macro 1 2 3)
(eval '(set! sr-id-macro (1 2 3))
syntax-test-env))
(test-end))
(else #f))