The call to display-results depends on the value of the current-namespace

parameter. Specifically, it is expected to be a namespace that has the GUI
bindings available. Unfortunately, during the dynamic extent of the
uncaught-exception-handler when a syntax error is raised, this may not be
the case because you get a phase 1 namespace, not a phase 0 one.

So, move the call to display-results to the code that runs the student language
programs and out of the uncaught exception handler.
This commit is contained in:
Robby Findler 2010-10-11 07:43:42 -05:00
parent e2958e0605
commit 8032705cf9
2 changed files with 16 additions and 20 deletions

View File

@ -157,11 +157,6 @@
(namespace-require scheme-signature-module-name) (namespace-require scheme-signature-module-name)
;; hack: the test-engine code knows about the test~object name; we do, too ;; hack: the test-engine code knows about the test~object name; we do, too
(namespace-set-variable-value! 'test~object (build-test-engine)) (namespace-set-variable-value! 'test~object (build-test-engine))
(uncaught-exception-handler
(let ((previous (uncaught-exception-handler)))
(lambda (exc)
(display-results)
(previous exc))))
;; record signature violations with the test engine ;; record signature violations with the test engine
(signature-violation-proc (signature-violation-proc
(lambda (obj signature message blame) (lambda (obj signature message blame)

View File

@ -57,7 +57,6 @@
#f #f
`(,#'module ,module-name ,language-module `(,#'module ,module-name ,language-module
,@(map (λ (x) `(require ,x)) teachpacks) ,@(map (λ (x) `(require ,x)) teachpacks)
,@body-exps
,@(if enable-testing? ,@(if enable-testing?
(if (null? body-exps) (if (null? body-exps)
'() '()
@ -65,24 +64,26 @@
;; over to the one that is used in the REPL when module->namepsace ;; over to the one that is used in the REPL when module->namepsace
;; grabs a hold of this module to make a namespace for the REPL ;; grabs a hold of this module to make a namespace for the REPL
`(,(syntax-property `(,(syntax-property
#'(define test~object (namespace-variable-value 'test~object)) #'(define test~object (namespace-variable-value 'test~object))
'test-call #t) 'test-call #t)))
(,#'test))) '())
'())))) ,@body-exps)))
rep)))] rep)))]
[(require) [(require)
(set! state 'done-or-exn) (set! state 'done-or-exn)
(stepper-syntax-property (stepper-syntax-property
(quasisyntax #`(let ([done-already? #f])
(let ([done-already? #f]) (dynamic-wind
(dynamic-wind void
void (lambda ()
(lambda () (dynamic-require ''#,module-name #f)) ;; work around a bug in dynamic-require
(dynamic-require ''#,module-name #f)) ;; work around a bug in dynamic-require (lambda ()
(lambda () (unless done-already?
(unless done-already? (set! done-already? #t)
(set! done-already? #t) #,(if enable-testing?
(current-namespace (module->namespace ''#,module-name))))))) #'(test)
#'(begin))
(current-namespace (module->namespace ''#,module-name))))))
'stepper-skip-completely 'stepper-skip-completely
#t)] #t)]
[(done-or-exn) [(done-or-exn)