From 32f1f1d8f1644f60abb41fb2b69ccc401faef5ad Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 20 Aug 2010 17:07:22 -0500 Subject: [PATCH] the error window for check syntax now goes away when you Run or edit the definitions window closes PR 11101 --- collects/drracket/private/syncheck/gui.rkt | 2 +- collects/tests/drracket/syncheck-test.rkt | 30 ++++++++++++++++------ 2 files changed, 23 insertions(+), 9 deletions(-) diff --git a/collects/drracket/private/syncheck/gui.rkt b/collects/drracket/private/syncheck/gui.rkt index 5a392c3442..922b6e27a7 100644 --- a/collects/drracket/private/syncheck/gui.rkt +++ b/collects/drracket/private/syncheck/gui.rkt @@ -1002,7 +1002,7 @@ If the namespace does not, they are colored the unbound color. (syncheck:clear-highlighting)) (define/public (syncheck:clear-error-message) - (unless error-report-visible? + (when error-report-visible? (set! error-report-visible? #f) (send report-error-text clear-output-ports) (send report-error-text lock #f) diff --git a/collects/tests/drracket/syncheck-test.rkt b/collects/tests/drracket/syncheck-test.rkt index 0ba2d298d9..5a4ebfa3c1 100644 --- a/collects/tests/drracket/syncheck-test.rkt +++ b/collects/tests/drracket/syncheck-test.rkt @@ -852,17 +852,29 @@ trigger runtime errors in check syntax. (let ([drs (wait-for-drscheme-frame)]) (set-language-level! (list "Pretty Big")) (do-execute drs) - (let* ([defs (send drs get-definitions-text)] + (let* ([defs (send drs get-definitions-text)] [filename (make-temporary-file "syncheck-test~a")]) (let-values ([(dir _1 _2) (split-path filename)]) - (send defs save-file filename) + (send defs save-file filename) (preferences:set 'framework:coloring-active #f) - (for-each (run-one-test (normalize-path dir)) tests) + (close-the-error-window-test drs) + ;(for-each (run-one-test (normalize-path dir)) tests) (preferences:set 'framework:coloring-active #t) (send defs save-file) ;; clear out autosave (send defs set-filename #f) (delete-file filename))))))) + (define (close-the-error-window-test drs) + (clear-definitions drs) + (insert-in-definitions drs "(") + (click-check-syntax-button drs) + (wait-for-computation drs) + (unless (send drs syncheck:error-report-visible?) + (error 'close-the-error-window-test "error report window never appeared")) + (do-execute drs) + (when (send drs syncheck:error-report-visible?) + (error 'close-the-error-window-test "error report window did not go away after clicking Run"))) + (define ((run-one-test save-dir) test) (let* ([drs (wait-for-drscheme-frame)] [defs (send drs get-definitions-text)] @@ -875,13 +887,11 @@ trigger runtime errors in check syntax. [(dir-test? test) (insert-in-definitions drs (format input (path->string relative)))] [else (insert-in-definitions drs input)]) - (test:run-one (lambda () (send (send drs syncheck:get-button) command))) + (click-check-syntax-button drs) (wait-for-computation drs) - ;; this isn't right -- seems like there is a race condition because - ;; wait-for-computation isn't waiting long enough? - '(when (send defs in-edit-sequence?) - (error 'syncheck-test.rkt "still in edit sequence for ~s" input)) + (when (send defs in-edit-sequence?) + (error 'syncheck-test.rkt "still in edit sequence for ~s" input)) (when (send drs syncheck:error-report-visible?) (fprintf (current-error-port) @@ -905,6 +915,7 @@ trigger runtime errors in check syntax. (send defs syncheck:get-bindings-table) input)))) + (define remappings '((constant default-color) (imported-syntax imported) @@ -995,4 +1006,7 @@ trigger runtime errors in check syntax. (channel-put chan (get-string/style-desc (send drs get-definitions-text))))) (channel-get chan))) + (define (click-check-syntax-button drs) + (test:run-one (lambda () (send (send drs syncheck:get-button) command)))) + (main)