Fix syntax depth calculation
This commit is contained in:
parent
2c5bf77f1c
commit
83f6f11496
|
@ -168,19 +168,21 @@ The module implements code coverage annotations as described in cover.rkt
|
|||
|
||||
;; Syntax -> Natural
|
||||
;; Maxiumum depth of begin-for-syntaxes
|
||||
(define (get-syntax-depth expr)
|
||||
(kernel-syntax-case
|
||||
(disarm expr) #f
|
||||
(define (get-syntax-depth expr [phase 0])
|
||||
(kernel-syntax-case/phase
|
||||
(disarm expr) phase
|
||||
[(module _ _ mb)
|
||||
(get-syntax-depth #'mb)]
|
||||
[(module* _ _ mb)
|
||||
(get-syntax-depth #'mb)]
|
||||
[(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 ...)
|
||||
2]
|
||||
[(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]))
|
||||
|
||||
;; Natural PathString Symbol -> Syntax
|
||||
|
|
6
cover/tests/bfs+define-syntax.rkt
Normal file
6
cover/tests/bfs+define-syntax.rkt
Normal 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))
|
|
@ -6,6 +6,7 @@
|
|||
(define-runtime-path-list others
|
||||
(list "bfs+module-nolex.rkt"
|
||||
"bfs+module.rkt"
|
||||
"bfs+define-syntax.rkt"
|
||||
"lazy-require.rkt"))
|
||||
(test-case
|
||||
"begin-for-syntax with modules should be okay"
|
||||
|
|
Loading…
Reference in New Issue
Block a user