tests for unstable/macro-testing
This commit is contained in:
parent
9ed78f2752
commit
7a0b100ce0
25
collects/tests/unstable/macro-testing.rkt
Normal file
25
collects/tests/unstable/macro-testing.rkt
Normal 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)))
|
|
@ -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]
|
||||
|
|
Loading…
Reference in New Issue
Block a user