diff --git a/collects/errortrace/errortrace-lib.ss b/collects/errortrace/errortrace-lib.ss index 2590d5e347..bb9b987205 100644 --- a/collects/errortrace/errortrace-lib.ss +++ b/collects/errortrace/errortrace-lib.ss @@ -266,6 +266,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (define orig-inspector (current-code-inspector)) + (define errortrace-annotate (lambda (top-e) (define (normal e) @@ -280,13 +282,17 @@ [(module name init-import (#%plain-module-begin body ...)) (normal #`(module name init-import - (#%plain-module-begin - #,((make-syntax-introducer) - #'(require (lib "errortrace-key.ss" "errortrace"))) - #,((make-syntax-introducer) - #'(require-for-syntax - (lib "errortrace-key.ss" "errortrace"))) - body ...)))])))] + #,(syntax-recertify + #`(#%plain-module-begin + #,((make-syntax-introducer) + #'(require (lib "errortrace-key.ss" "errortrace"))) + #,((make-syntax-introducer) + #'(require-for-syntax + (lib "errortrace-key.ss" "errortrace"))) + body ...) + (list-ref (syntax->list top-e) 3) + orig-inspector + #f)))])))] [_else (normal top-e)]))) diff --git a/collects/errortrace/stacktrace.ss b/collects/errortrace/stacktrace.ss index 9dca9fe5a2..43c9900f70 100644 --- a/collects/errortrace/stacktrace.ss +++ b/collects/errortrace/stacktrace.ss @@ -397,14 +397,21 @@ ;; Just wrap body expressions [(module name init-import (#%plain-module-begin body ...)) top? - (let ([bodys (syntax->list (syntax (body ...)))]) + (let ([bodys (syntax->list (syntax (body ...)))] + [mb (list-ref (syntax->list expr) 3)]) (let ([bodyl (map (lambda (b) (annotate-top b trans?)) bodys)]) - (certify - expr - (rebuild expr (map cons bodys bodyl)))))] - + (certify + expr + (rebuild + expr + (list (cons + mb + (certify + mb + (rebuild mb (map cons bodys bodyl)))))))))] + ;; No way to wrap [(require i ...) expr] [(require-for-syntax i ...) expr] diff --git a/collects/setup/configtab.ss b/collects/setup/configtab.ss index a54d540efe..d3477d7479 100644 --- a/collects/setup/configtab.ss +++ b/collects/setup/configtab.ss @@ -77,11 +77,13 @@ (if (memq id syms) '() (list #`(define #,(datum->syntax-object stx id stx) #,v)))) - #`(#%plain-module-begin - (provide #,@path-exports #,@flag-exports) - (define name expr) ... - #,@(apply append (map (mkdef #'use-default) path-exports)) - #,@(apply append (map (mkdef #'#f) flag-exports))))))]))) + (syntax-property + #`(#%plain-module-begin + (provide #,@path-exports #,@flag-exports) + (define name expr) ... + #,@(apply append (map (mkdef #'use-default) path-exports)) + #,@(apply append (map (mkdef #'#f) flag-exports))) + 'certify-mode 'transparent))))]))) (provide (rename config-module-begin #%module-begin) define