Fix syntax depth calculation

This commit is contained in:
Asumu Takikawa 2016-05-12 18:23:38 -04:00
parent 2c5bf77f1c
commit 83f6f11496
3 changed files with 14 additions and 5 deletions

View File

@ -168,19 +168,21 @@ The module implements code coverage annotations as described in cover.rkt
;; Syntax -> Natural ;; Syntax -> Natural
;; Maxiumum depth of begin-for-syntaxes ;; Maxiumum depth of begin-for-syntaxes
(define (get-syntax-depth expr) (define (get-syntax-depth expr [phase 0])
(kernel-syntax-case (kernel-syntax-case/phase
(disarm expr) #f (disarm expr) phase
[(module _ _ mb) [(module _ _ mb)
(get-syntax-depth #'mb)] (get-syntax-depth #'mb)]
[(module* _ _ mb) [(module* _ _ mb)
(get-syntax-depth #'mb)] (get-syntax-depth #'mb)]
[(begin-for-syntax b ...) [(begin-for-syntax b ...)
(add1 (apply max 1 (map get-syntax-depth (syntax->list #'(b ...)))))] (add1 (apply max 1 (for/list ([b (in-list (syntax->list #'(b ...)))])
(get-syntax-depth b (add1 phase)))))]
[(define-syntaxes a ...) [(define-syntaxes a ...)
2] 2]
[(b ...) [(b ...)
(apply max 1 (map get-syntax-depth (syntax->list #'(b ...))))] (apply max 1 (for/list ([b (in-list (syntax->list #'(b ...)))])
(get-syntax-depth b phase)))]
[_ 1])) [_ 1]))
;; Natural PathString Symbol -> Syntax ;; Natural PathString Symbol -> Syntax

View File

@ -0,0 +1,6 @@
#lang racket/base
(require (for-meta 1 racket/base)
(for-meta 2 racket/base))
(begin-for-syntax (define-syntax x #f))

View File

@ -6,6 +6,7 @@
(define-runtime-path-list others (define-runtime-path-list others
(list "bfs+module-nolex.rkt" (list "bfs+module-nolex.rkt"
"bfs+module.rkt" "bfs+module.rkt"
"bfs+define-syntax.rkt"
"lazy-require.rkt")) "lazy-require.rkt"))
(test-case (test-case
"begin-for-syntax with modules should be okay" "begin-for-syntax with modules should be okay"