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

add the place creation memory use to the memory-log test

Browse Source 
(this required rearranging a bunch of local-member-names)
This commit is contained in:
Robby Findler 2011-09-20 14:47:37 -05:00
parent 35de11134b
commit d654d3e09b
11 changed files with 89 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/drracket/check-syntax.rkt
View File

@ -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

2
collects/drracket/private/module-language.rkt
View File

@ -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)

3
collects/drracket/private/syncheck/annotate.rkt
View File

@ -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)

3
collects/drracket/private/syncheck/contract-traversal.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require "intf.rkt"
(require "intf.rkt"
"local-member-names.rkt"
"annotate.rkt"
"colors.rkt"
syntax/boundmap

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

@ -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)

83
collects/drracket/private/syncheck/intf.rkt
View File

@ -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)

43
collects/drracket/private/syncheck/local-member-names.rkt Normal file
View File

@ -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)

3
collects/drracket/private/syncheck/online-comp.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base
(require racket/class
racket/place
"traversals.rkt"
"traversals.rkt"
"local-member-names.rkt"
"intf.rkt")
(provide go)

1
collects/drracket/private/syncheck/traversals.rkt
View File

@ -2,6 +2,7 @@
(require "colors.rkt"
"intf.rkt"
"local-member-names.rkt"
"annotate.rkt"
"contract-traversal.rkt"
string-constants

34
collects/tests/drracket/memory-log.rkt
View File

@ -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))))

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

@ -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