tests for unstable/macro-testing

This commit is contained in:
Ryan Culpepper 2013-02-14 12:02:29 -05:00
parent 9ed78f2752
commit 7a0b100ce0
2 changed files with 31 additions and 6 deletions

View File

@ -0,0 +1,25 @@
#lang racket/base
(require rackunit)
(define ns (make-base-namespace))
(eval '(require unstable/macro-testing) ns)
(define-check (check-expand/eval term)
;; Checks that term expands w/o error, and that expanded form is writable...
(check-not-exn (lambda () (format "~s" (parameterize ((current-namespace ns)) (expand term)))))
;; ...then checks that term evals raising an error.
(check-exn (lambda _ #t) (lambda () (eval term ns))))
(test-case "convert-*-error"
(check-expand/eval '(convert-syntax-error (lambda)))
(check-expand/eval '(convert-compile-time-error (lambda)))
;; syntax exn for term with unsealed intdefctx:
(check-expand/eval '(convert-syntax-error (let () (define x) x)))
(check-expand/eval '(convert-compile-time-error (let () (define x) x))))
(test-case "phase1-eval"
(eval '(require (for-syntax racket racket/struct-info)) ns)
(eval '(struct point (x y)) ns)
(define ct-expr '(extract-struct-info (syntax-local-value #'point)))
(check-pred list? (eval `(phase1-eval ,ct-expr) ns))
(check-pred syntax? (eval `(phase1-eval ,ct-expr #:quote quote-syntax) ns)))

View File

@ -1,6 +1,7 @@
#lang racket/base
(require (for-syntax racket/base
racket/syntax
syntax/strip-context
syntax/keyword))
(provide phase1-eval
convert-syntax-error
@ -8,16 +9,15 @@
(begin-for-syntax
(define (exn->raise-syntax e)
(cond #|
;; Preserving exn:fail:syntax causes the "unsealed local-definition context found
;; in fully expanded form" error in some tests.
[(exn:fail:syntax? e)
(cond [(exn:fail:syntax? e)
#`(raise (make-exn:fail:syntax
#,(exn-message e)
(current-continuation-marks)
#,(with-syntax ([(expr ...) (exn:fail:syntax-exprs e)])
;; Lexical context must be stripped to avoid "unsealed local-definition context
;; found in fully expanded form" error in cases like the following:
;; (convert-syntax-error (let () (define x) x))
#,(with-syntax ([(expr ...) (map strip-context (exn:fail:syntax-exprs e))])
#'(list (quote-syntax expr) ...))))]
|#
[(exn? e)
(with-syntax ([make-exn
(cond [(exn:fail? e) #'make-exn:fail]