Add identifier macro tests to syntax-test.scm

tests/syntax-tests.scm

@@ -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))