diff --git a/pkgs/drracket-pkgs/drracket-test/tests/drracket/follow-log.rkt b/pkgs/drracket-pkgs/drracket-test/tests/drracket/follow-log.rkt deleted file mode 100644 index afbd0cc8..00000000 --- a/pkgs/drracket-pkgs/drracket-test/tests/drracket/follow-log.rkt +++ /dev/null @@ -1,124 +0,0 @@ -#lang racket/base - -#| - -This file sets up a log receiver and then -starts up DrRacket. It catches log messages and -organizes them on event boundaries, printing -out the ones that take the longest -(possibly dropping those where a gc occurs) - -The result shows, for each gui event, the -log messages that occured during its dynamic -extent as well as the number of milliseconds -from the start of the gui event before the -log message was reported. - -(This is not really a test suite, but instead - a tool to help understand DrRacket's performance) - -|# - -(define start-right-away? #t) ;; only applies if the 'main' module is loaded -(define script-drr? #t) - -(require racket/list - racket/class - racket/match - racket/pretty - racket/gui/base - framework/private/logging-timer - framework/private/follow-log) - -(define drr-eventspace (current-eventspace)) -(require tests/drracket/private/drracket-test-util - framework/test) - -(test:use-focus-table #t) - -;; running on controller-frame-eventspace handler thread -(define (run-drracket-script) - (test:use-focus-table #t) - (test:current-get-eventspaces (λ () (list drr-eventspace))) - (define drr (wait-for-drracket-frame)) - - (define (wait-until something) - (define chan (make-channel)) - (let loop () - (sleep 1) - (parameterize ([current-eventspace drr-eventspace]) - (queue-callback - (λ () - (channel-put chan (something))))) - (unless (channel-get chan) - (loop)))) - - (define (online-syncheck-done) - (define-values (colors labels) (send (send drr get-current-tab) get-bkg-running)) - (equal? colors '("forestgreen"))) - - (define (syntax-coloring-done) - (send (send drr get-definitions-text) is-lexer-valid?)) - - (sync - (thread - (λ () - (current-eventspace drr-eventspace) - (test:current-get-eventspaces (λ () (list drr-eventspace))) - (test:use-focus-table #t) - (test:menu-select "View" "Hide Interactions") - (test:menu-select "Edit" "Find") - - (define s (make-semaphore)) - (parameterize ([current-eventspace drr-eventspace]) - (queue-callback - (λ () - (define defs (send drr get-definitions-text)) - (send defs load-file (collection-file-path "class-internal.rkt" "racket" "private")) - (define open-quote-pos (send defs find-string "\"")) - (when open-quote-pos (send defs set-position open-quote-pos)) - (send (send defs get-canvas) focus) - (semaphore-post s))) - #f) - (semaphore-wait s) - - ;(wait-until online-syncheck-done) - - (for ([x (in-range 1)]) - - - (let ([s "fdjafjdklafjkdalsfjdaklfjdkaslfdjafjdklafjkdalsfjdaklfjdkasl"]) - (for ([c (in-string s)]) - (test:keystroke c) - ;(test:keystroke #\return) - (sleep .3)) - #; - (for ([c (in-string s)]) - (test:keystroke #\backspace) - (test:keystroke #\backspace))) - #; - (begin - (test:keystroke #\") - (test:keystroke #\a) - (wait-until syntax-coloring-done) - (test:keystroke #\backspace) - (test:keystroke #\backspace) - (wait-until syntax-coloring-done)) - ) - '(sleep 10)))) ;; let everything finish - - (stop-and-dump) - (exit)) - - -(module+ main - (when start-right-away? - (parameterize ([current-eventspace controller-frame-eventspace]) - (queue-callback sb-callback))) - (dynamic-require 'drracket #f) - (when script-drr? - (parameterize ([current-eventspace controller-frame-eventspace]) - (queue-callback - (λ () - (run-drracket-script)))))) - diff --git a/pkgs/gui-pkgs/gui-test/tests/gracket/blits.rkt b/pkgs/gui-pkgs/gui-test/tests/gracket/blits.rkt index 02b43533..d7d2b903 100644 --- a/pkgs/gui-pkgs/gui-test/tests/gracket/blits.rkt +++ b/pkgs/gui-pkgs/gui-test/tests/gracket/blits.rkt @@ -58,15 +58,15 @@ (define targets (list - (collection-file-path "clock.png" "frtime" "tool") - (self-mask (collection-file-path "clock.png" "frtime" "tool")) + ;; (collection-file-path "clock.png" "frtime" "tool") + ;; (self-mask (collection-file-path "clock.png" "frtime" "tool")) (collection-file-path "foot-up.png" "icons") (collection-file-path "mred.xbm" "icons") (self-mask (collection-file-path "mred.xbm" "icons")) (plus-mask (collection-file-path "mred.xbm" "icons") (collection-file-path "PLT-206.png" "icons")) - (plus-mask (collection-file-path "clock.png" "frtime" "tool") - (collection-file-path "mred.xbm" "icons")) + ;; (plus-mask (collection-file-path "clock.png" "frtime" "tool") + ;; (collection-file-path "mred.xbm" "icons")) (collection-file-path "htdp-icon.gif" "icons") ))