From 284ba01db60dee808d0417ad0a99aa5ac0e2707e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 9 Feb 2012 17:58:28 -0700 Subject: [PATCH] errortrace: skip annotation in namespace with wrong base phase Closes PR 12551 --- collects/errortrace/errortrace-lib.rkt | 5 ++++- collects/errortrace/scribblings/errortrace.scrbl | 5 +++-- collects/tests/errortrace/main.rkt | 4 +++- collects/tests/errortrace/phase-1-eval.rkt | 12 ++++++++++++ 4 files changed, 22 insertions(+), 4 deletions(-) create mode 100644 collects/tests/errortrace/phase-1-eval.rkt diff --git a/collects/errortrace/errortrace-lib.rkt b/collects/errortrace/errortrace-lib.rkt index 13b0045534..aa18a3c0fe 100644 --- a/collects/errortrace/errortrace-lib.rkt +++ b/collects/errortrace/errortrace-lib.rkt @@ -436,7 +436,8 @@ (define (make-errortrace-compile-handler) (let ([orig (current-compile)] - [reg (namespace-module-registry (current-namespace))]) + [reg (namespace-module-registry (current-namespace))] + [phase (namespace-base-phase (current-namespace))]) (namespace-attach-module (namespace-anchor->namespace orig-namespace) 'racket/base) (namespace-attach-module (namespace-anchor->namespace orig-namespace) 'errortrace/errortrace-key) (lambda (e immediate-eval?) @@ -444,6 +445,8 @@ (if (and (instrumenting-enabled) (eq? reg (namespace-module-registry (current-namespace))) + (equal? phase + (namespace-base-phase (current-namespace))) (not (compiled-expression? (if (syntax? e) (syntax-e e) e)))) diff --git a/collects/errortrace/scribblings/errortrace.scrbl b/collects/errortrace/scribblings/errortrace.scrbl index 4efde7d5eb..7fde0bdf09 100644 --- a/collects/errortrace/scribblings/errortrace.scrbl +++ b/collects/errortrace/scribblings/errortrace.scrbl @@ -237,7 +237,7 @@ source location information) for the original expression, and the second element of the pair indicates if the code has been executed. This list is snapshot of the current state of the computation.} -@defproc[(get-execute-counts) (list (cons/c syntax? number?))])]{ +@defproc[(get-execute-counts) (list (cons/c syntax? number?))]{ Returns a list of pairs, one for each instrumented expression. The first element of the pair is a @racket[syntax?] object (usually containing source location information) for the original expression, and the @@ -308,7 +308,8 @@ Compiles @racket[stx] using the compilation handler that was active when the @racketmodname[errortrace/errortrace-lib] module was executed, but first instruments the code for Errortrace information. The code is instrumented only if -@racketblock[(namespace-module-registry (current-namespace))] +@racketblock[(list (namespace-module-registry (current-namespace)) + (namespace-base-phase (current-namespace)))] is the same as when the @racketmodname[errortrace/errortrace-lib] module was executed. This procedure is suitable for use as a compilation handler via diff --git a/collects/tests/errortrace/main.rkt b/collects/tests/errortrace/main.rkt index 8cc03cc17d..07c7dc0e8a 100644 --- a/collects/tests/errortrace/main.rkt +++ b/collects/tests/errortrace/main.rkt @@ -3,10 +3,12 @@ (require tests/eli-tester "wrap.rkt" "alert.rkt" - "phase-1.rkt") + "phase-1.rkt" + "phase-1-eval.rkt") (wrap-tests) (test do (alert-tests)) (phase-1-tests) +(phase-1-eval-tests) diff --git a/collects/tests/errortrace/phase-1-eval.rkt b/collects/tests/errortrace/phase-1-eval.rkt new file mode 100644 index 0000000000..1c47afe0c3 --- /dev/null +++ b/collects/tests/errortrace/phase-1-eval.rkt @@ -0,0 +1,12 @@ +#lang racket/base + +(provide phase-1-eval-tests) + +;; Check that eval at phase 1 doesn't use errortrace. +(define (phase-1-eval-tests) + (define ns (make-base-namespace)) + (parameterize ([current-namespace ns]) + (namespace-require '(for-syntax (only racket/base + eval quote #%app #%datum))) + (dynamic-require 'errortrace #f) + (eval '(begin-for-syntax (eval '(+ 1 2)))))) +