diff --git a/collects/drracket/check-syntax.rkt b/collects/drracket/check-syntax.rkt index 0fff0bbe03..90bd6bffc7 100644 --- a/collects/drracket/check-syntax.rkt +++ b/collects/drracket/check-syntax.rkt @@ -2,7 +2,8 @@ (require racket/contract racket/class "private/syncheck/traversals.rkt" - "private/syncheck/intf.rkt") + "private/syncheck/intf.rkt" + "private/syncheck/local-member-names.rkt") (provide/contract [make-traversal diff --git a/collects/drracket/private/module-language.rkt b/collects/drracket/private/module-language.rkt index 39354610a2..0101ccb3ac 100644 --- a/collects/drracket/private/module-language.rkt +++ b/collects/drracket/private/module-language.rkt @@ -1126,6 +1126,8 @@ (λ () (when (eq? t pending-thread) (set! pending-thread #f) + (when (getenv "PLTDRPLACEPRINT") + (printf "PLTDRPLACEPRINT: got results back from the place\n")) (show-results res)))))))))) (define (stop-place-running) diff --git a/collects/drracket/private/syncheck/annotate.rkt b/collects/drracket/private/syncheck/annotate.rkt index 17211b3164..30351f3715 100644 --- a/collects/drracket/private/syncheck/annotate.rkt +++ b/collects/drracket/private/syncheck/annotate.rkt @@ -1,6 +1,7 @@ #lang racket/base (require racket/class - "intf.rkt") + "intf.rkt" + "local-member-names.rkt") (provide color color-range find-source-editor find-source-editor/defs) diff --git a/collects/drracket/private/syncheck/contract-traversal.rkt b/collects/drracket/private/syncheck/contract-traversal.rkt index 095c90c71d..34e8bee9e0 100644 --- a/collects/drracket/private/syncheck/contract-traversal.rkt +++ b/collects/drracket/private/syncheck/contract-traversal.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require "intf.rkt" +(require "intf.rkt" + "local-member-names.rkt" "annotate.rkt" "colors.rkt" syntax/boundmap diff --git a/collects/drracket/private/syncheck/gui.rkt b/collects/drracket/private/syncheck/gui.rkt index 6cbfd568a1..61eba440bb 100644 --- a/collects/drracket/private/syncheck/gui.rkt +++ b/collects/drracket/private/syncheck/gui.rkt @@ -48,6 +48,7 @@ If the namespace does not, they are colored the unbound color. (only-in ffi/unsafe register-finalizer) "../../syncheck-drracket-button.rkt" "intf.rkt" + "local-member-names.rkt" "colors.rkt" "traversals.rkt" "annotate.rkt" @@ -321,7 +322,7 @@ If the namespace does not, they are colored the unbound color. ;; - tail-link ;; - arrow ;; - string - (define (get-arrow-record table text) + (define/private (get-arrow-record table text) (hash-ref! table text (lambda () (make-interval-map)))) (define arrow-records #f) diff --git a/collects/drracket/private/syncheck/intf.rkt b/collects/drracket/private/syncheck/intf.rkt index a5b9388d11..7c4cc0b744 100644 --- a/collects/drracket/private/syncheck/intf.rkt +++ b/collects/drracket/private/syncheck/intf.rkt @@ -1,47 +1,8 @@ #lang racket/base (require racket/class racket/promise - setup/xref) - -(define-local-member-name - syncheck:init-arrows - syncheck:clear-arrows - syncheck:arrows-visible? - - syncheck:find-source-object - syncheck:add-background-color - syncheck:add-docs-menu - syncheck:color-range - syncheck:add-require-open-menu - syncheck:add-rename-menu - syncheck:add-arrow - syncheck:add-tail-arrow - syncheck:add-mouse-over-status - syncheck:add-jump-to-definition - - syncheck:sort-bindings-table - syncheck:jump-to-next-bound-occurrence - syncheck:jump-to-binding-occurrence - syncheck:jump-to-definition - - syncheck:clear-highlighting - syncheck:apply-style/remember - ;syncheck:error-report-visible? ;; test suite uses this one. - ;syncheck:get-bindings-table ;; test suite uses this one. - syncheck:clear-error-message - - hide-error-report - get-error-report-text - get-error-report-visible? - - turn-off-error-report - turn-on-error-report - - update-button-visibility/settings - - set-syncheck-mode - get-syncheck-mode - update-menu-status) + setup/xref + "local-member-names.rkt") (define syncheck-annotations<%> (interface () @@ -104,42 +65,4 @@ syncheck-annotations<%> current-annotations annotations-mixin - get-xref - - ;; methods - syncheck:init-arrows - syncheck:clear-arrows - syncheck:arrows-visible? - syncheck:add-arrow - syncheck:add-tail-arrow - syncheck:add-mouse-over-status - syncheck:add-jump-to-definition - syncheck:add-docs-menu - syncheck:add-require-open-menu - syncheck:add-rename-menu - syncheck:add-background-color - syncheck:sort-bindings-table - syncheck:jump-to-next-bound-occurrence - syncheck:jump-to-binding-occurrence - syncheck:jump-to-definition - - syncheck:clear-highlighting - syncheck:apply-style/remember - ;syncheck:error-report-visible? ;; test suite uses this one. - ;syncheck:get-bindings-table ;; test suite uses this one. - syncheck:clear-error-message - syncheck:color-range - syncheck:find-source-object - - hide-error-report - get-error-report-text - get-error-report-visible? - - turn-off-error-report - turn-on-error-report - - update-button-visibility/settings - - set-syncheck-mode - get-syncheck-mode - update-menu-status) + get-xref) diff --git a/collects/drracket/private/syncheck/local-member-names.rkt b/collects/drracket/private/syncheck/local-member-names.rkt new file mode 100644 index 0000000000..b8a0adf767 --- /dev/null +++ b/collects/drracket/private/syncheck/local-member-names.rkt @@ -0,0 +1,43 @@ +#lang racket/base +(require racket/class) +(provide (all-defined-out)) + +(define-local-member-name + syncheck:init-arrows + syncheck:clear-arrows + syncheck:arrows-visible? + + syncheck:find-source-object + syncheck:add-background-color + syncheck:add-docs-menu + syncheck:color-range + syncheck:add-require-open-menu + syncheck:add-rename-menu + syncheck:add-arrow + syncheck:add-tail-arrow + syncheck:add-mouse-over-status + syncheck:add-jump-to-definition + + syncheck:sort-bindings-table + syncheck:jump-to-next-bound-occurrence + syncheck:jump-to-binding-occurrence + syncheck:jump-to-definition + + syncheck:clear-highlighting + syncheck:apply-style/remember + ;syncheck:error-report-visible? ;; test suite uses this one. + ;syncheck:get-bindings-table ;; test suite uses this one. + syncheck:clear-error-message + + hide-error-report + get-error-report-text + get-error-report-visible? + + turn-off-error-report + turn-on-error-report + + update-button-visibility/settings + + set-syncheck-mode + get-syncheck-mode + update-menu-status) \ No newline at end of file diff --git a/collects/drracket/private/syncheck/online-comp.rkt b/collects/drracket/private/syncheck/online-comp.rkt index 34d4da642e..f03d15574d 100644 --- a/collects/drracket/private/syncheck/online-comp.rkt +++ b/collects/drracket/private/syncheck/online-comp.rkt @@ -1,7 +1,8 @@ #lang racket/base (require racket/class racket/place - "traversals.rkt" + "traversals.rkt" + "local-member-names.rkt" "intf.rkt") (provide go) diff --git a/collects/drracket/private/syncheck/traversals.rkt b/collects/drracket/private/syncheck/traversals.rkt index 8ba4c0eae4..c886cbf3dc 100644 --- a/collects/drracket/private/syncheck/traversals.rkt +++ b/collects/drracket/private/syncheck/traversals.rkt @@ -2,6 +2,7 @@ (require "colors.rkt" "intf.rkt" + "local-member-names.rkt" "annotate.rkt" "contract-traversal.rkt" string-constants diff --git a/collects/tests/drracket/memory-log.rkt b/collects/tests/drracket/memory-log.rkt index 5c4245284e..ed0e4a6b48 100644 --- a/collects/tests/drracket/memory-log.rkt +++ b/collects/tests/drracket/memory-log.rkt @@ -2,11 +2,15 @@ (require "private/drracket-test-util.rkt" racket/gui/base racket/class - framework/test) + framework/test + framework/preferences + drracket/private/syncheck/local-member-names) ;; for the syncheck:arrows-visible? method (printf "The printouts below are designed to trick drdr into graphing them;\n") (printf "they aren't times, but memory usage. The first is starting up DrRacket,\n") -(printf "the second is after the documentation index has been loaded.\n") +(printf "the second is after the documentation index has been loaded (via check\n") +(printf "syntax) and the third is after online check syntax has completed once (so\n") +(printf "a place was created and the docs loaded there.\n") ;; mem-cnt returns the amount of memory used, iterating (collect-garbage) ;; until the delta is less than 10k or we've done it 20 times. @@ -24,6 +28,7 @@ (loop new-cmu (- n 1))])))) (void (putenv "PLTDRXREFDELAY" "yes")) +(void (putenv "PLTDRPLACEPRINT" "yes")) (define (wait-and-print) (let ([s (make-semaphore 0)]) @@ -40,12 +45,31 @@ (λ () (let ([drs-frame (wait-for-drscheme-frame)]) + ;; initial startup memory use (wait-and-print) - (send (send drs-frame get-definitions-text) insert "#lang racket/base\n+") + ;; figure out the memory use after running check syntax once (and so the docs + ;; have been loaded) + (queue-callback + (λ () (send (send drs-frame get-definitions-text) insert "#lang racket/base\n+"))) (set-module-language!) (test:run-one (lambda () (send (send drs-frame syncheck:get-button) command))) (wait-for-computation drs-frame) + (wait-and-print) - (wait-and-print)))) - + ;; figure out the memory use after letting online check syntax run once + ;; (so a place has been created and the docs loaded again (in the other place + ;; this time)) + + ; clear out the check synax results from before + (queue-callback/res (λ () (send (send drs-frame get-definitions-text) insert "\n"))) + (poll-until + (λ () + (not (send (send drs-frame get-definitions-text) syncheck:arrows-visible?)))) + + ; enable online check syntax and wait for the results to appear + (queue-callback/res (λ () (preferences:set 'drracket:online-compilation-default-off #t))) + (poll-until + (λ () + (send (send drs-frame get-definitions-text) syncheck:arrows-visible?))) + (wait-and-print)))) diff --git a/collects/tests/drracket/syncheck-test.rkt b/collects/tests/drracket/syncheck-test.rkt index 6f788dc395..2f82f9cd55 100644 --- a/collects/tests/drracket/syncheck-test.rkt +++ b/collects/tests/drracket/syncheck-test.rkt @@ -8,6 +8,7 @@ trigger runtime errors in check syntax. |# (require "private/drracket-test-util.rkt" + drracket/private/syncheck/local-member-names string-constants/string-constant tests/utils/gui racket/path