suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

the error window for check syntax now goes away when you Run or edit the definitions window

Browse Source 
closes PR 11101
This commit is contained in:
Robby Findler 2010-08-20 17:07:22 -05:00
parent d93fc805f3
commit 32f1f1d8f1
2 changed files with 23 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/drracket/private/syncheck/gui.rkt
View File

@ -1002,7 +1002,7 @@ If the namespace does not, they are colored the unbound color.
(syncheck:clear-highlighting)) (syncheck:clear-highlighting))
(define/public (syncheck:clear-error-message) (define/public (syncheck:clear-error-message)
(unless error-report-visible? (when error-report-visible?
(set! error-report-visible? #f) (set! error-report-visible? #f)
(send report-error-text clear-output-ports) (send report-error-text clear-output-ports)
(send report-error-text lock #f) (send report-error-text lock #f)

30
collects/tests/drracket/syncheck-test.rkt
View File

@ -852,17 +852,29 @@ trigger runtime errors in check syntax.
(let ([drs (wait-for-drscheme-frame)]) (let ([drs (wait-for-drscheme-frame)])
(set-language-level! (list "Pretty Big")) (set-language-level! (list "Pretty Big"))
(do-execute drs) (do-execute drs)
(let* ([defs (send drs get-definitions-text)] (let* ([defs (send drs get-definitions-text)]
[filename (make-temporary-file "syncheck-test~a")]) [filename (make-temporary-file "syncheck-test~a")])
(let-values ([(dir _1 _2) (split-path filename)]) (let-values ([(dir _1 _2) (split-path filename)])
(send defs save-file filename) (send defs save-file filename)
(preferences:set 'framework:coloring-active #f) (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) (preferences:set 'framework:coloring-active #t)
(send defs save-file) ;; clear out autosave (send defs save-file) ;; clear out autosave
(send defs set-filename #f) (send defs set-filename #f)
(delete-file filename))))))) (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) (define ((run-one-test save-dir) test)
(let* ([drs (wait-for-drscheme-frame)] (let* ([drs (wait-for-drscheme-frame)]
[defs (send drs get-definitions-text)] [defs (send drs get-definitions-text)]
@ -875,13 +887,11 @@ trigger runtime errors in check syntax.
[(dir-test? test) [(dir-test? test)
(insert-in-definitions drs (format input (path->string relative)))] (insert-in-definitions drs (format input (path->string relative)))]
[else (insert-in-definitions drs input)]) [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) (wait-for-computation drs)
;; this isn't right -- seems like there is a race condition because (when (send defs in-edit-sequence?)
;; wait-for-computation isn't waiting long enough? (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?) (when (send drs syncheck:error-report-visible?)
(fprintf (current-error-port) (fprintf (current-error-port)
@ -905,6 +915,7 @@ trigger runtime errors in check syntax.
(send defs syncheck:get-bindings-table) (send defs syncheck:get-bindings-table)
input)))) input))))
(define remappings (define remappings
'((constant default-color) '((constant default-color)
(imported-syntax imported) (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-put chan (get-string/style-desc (send drs get-definitions-text)))))
(channel-get chan))) (channel-get chan)))
(define (click-check-syntax-button drs)
(test:run-one (lambda () (send (send drs syncheck:get-button) command))))
(main) (main)