refactored to make testing check syntax renaming possible
made sure to remove duplicates from the list before doing renaming closes PR 11659
This commit is contained in:
Robby Findler
parent
ac083b9148
commit
45a635339e
|
|
@ -69,6 +69,7 @@ If the namespace does not, they are colored the unbound color.
|
|||
(λ (x) (memq x '(default-mode
|
||||
my-obligations-mode
|
||||
client-obligations-mode))))
|
||||
|
||||
(define tool@
|
||||
(unit
|
||||
(import drracket:tool^)
|
||||
|
|
@ -691,90 +692,99 @@ If the namespace does not, they are colored the unbound color.
|
|||
(invalidate-bitmap-cache))]))
|
||||
(super on-event event)]
|
||||
[(send event button-down? 'right)
|
||||
(let-values ([(pos text) (get-pos/text event)])
|
||||
(if (and pos (is-a? text text%))
|
||||
(let ([arrow-record (hash-ref arrow-records text #f)])
|
||||
(when arrow-record
|
||||
(let ([vec-ents (interval-map-ref arrow-record pos null)]
|
||||
[start-selection (send text get-start-position)]
|
||||
[end-selection (send text get-end-position)])
|
||||
(cond
|
||||
[(and (null? vec-ents) (= start-selection end-selection))
|
||||
(super on-event event)]
|
||||
[else
|
||||
(let* ([menu (make-object popup-menu% #f)]
|
||||
[arrows (filter arrow? vec-ents)]
|
||||
[def-links (filter def-link? vec-ents)]
|
||||
[var-arrows (filter var-arrow? arrows)]
|
||||
[add-menus (map cdr (filter pair? vec-ents))])
|
||||
(unless (null? arrows)
|
||||
(make-object menu-item%
|
||||
(string-constant cs-tack/untack-arrow)
|
||||
menu
|
||||
(λ (item evt) (tack/untack-callback arrows))))
|
||||
(unless (null? def-links)
|
||||
(let ([def-link (car def-links)])
|
||||
(make-object menu-item%
|
||||
jump-to-definition
|
||||
menu
|
||||
(λ (item evt)
|
||||
(jump-to-definition-callback def-link)))))
|
||||
(unless (null? var-arrows)
|
||||
(make-object menu-item%
|
||||
jump-to-next-bound-occurrence
|
||||
menu
|
||||
(λ (item evt) (jump-to-next-callback pos text arrows)))
|
||||
(make-object menu-item%
|
||||
jump-to-binding
|
||||
menu
|
||||
(λ (item evt) (jump-to-binding-callback arrows))))
|
||||
(unless (= start-selection end-selection)
|
||||
(let ([arrows-menu
|
||||
(make-object menu%
|
||||
"Arrows crossing selection"
|
||||
menu)]
|
||||
[callback
|
||||
(lambda (accept)
|
||||
(tack-crossing-arrows-callback
|
||||
arrow-record
|
||||
start-selection
|
||||
end-selection
|
||||
text
|
||||
accept))])
|
||||
(make-object menu-item%
|
||||
"Tack arrows"
|
||||
arrows-menu
|
||||
(lambda (item evt)
|
||||
(callback
|
||||
'(lexical top-level imported))))
|
||||
(make-object menu-item%
|
||||
"Tack non-import arrows"
|
||||
arrows-menu
|
||||
(lambda (item evt)
|
||||
(callback
|
||||
'(lexical top-level))))
|
||||
(make-object menu-item%
|
||||
"Untack arrows"
|
||||
arrows-menu
|
||||
(lambda (item evt)
|
||||
(untack-crossing-arrows
|
||||
arrow-record
|
||||
start-selection
|
||||
end-selection)))))
|
||||
(for-each (λ (f) (f menu)) add-menus)
|
||||
|
||||
(drracket:unit:add-search-help-desk-menu-item
|
||||
text
|
||||
menu
|
||||
event
|
||||
(λ () (new separator-menu-item% [parent menu])))
|
||||
|
||||
(send (get-canvas) popup-menu menu
|
||||
(+ 1 (inexact->exact (floor (send event get-x))))
|
||||
(+ 1 (inexact->exact (floor (send event get-y))))))]))))
|
||||
(super on-event event)))]
|
||||
(define menu
|
||||
(let-values ([(pos text) (get-pos/text event)])
|
||||
(syncheck:build-popup-menu pos text)))
|
||||
(cond
|
||||
[menu
|
||||
(send (get-canvas) popup-menu menu
|
||||
(+ 1 (inexact->exact (floor (send event get-x))))
|
||||
(+ 1 (inexact->exact (floor (send event get-y)))))]
|
||||
[else
|
||||
(super on-event event)])]
|
||||
[else (super on-event event)])
|
||||
(super on-event event)))
|
||||
|
||||
(define/public (syncheck:build-popup-menu pos text)
|
||||
(and pos
|
||||
(is-a? text text%)
|
||||
(let ([arrow-record (hash-ref arrow-records text #f)])
|
||||
(and arrow-record
|
||||
(let ([vec-ents (interval-map-ref arrow-record pos null)]
|
||||
[start-selection (send text get-start-position)]
|
||||
[end-selection (send text get-end-position)])
|
||||
(cond
|
||||
[(and (null? vec-ents) (= start-selection end-selection))
|
||||
#f]
|
||||
[else
|
||||
(let* ([menu (make-object popup-menu% #f)]
|
||||
[arrows (filter arrow? vec-ents)]
|
||||
[def-links (filter def-link? vec-ents)]
|
||||
[var-arrows (filter var-arrow? arrows)]
|
||||
[add-menus (map cdr (filter pair? vec-ents))])
|
||||
(unless (null? arrows)
|
||||
(make-object menu-item%
|
||||
(string-constant cs-tack/untack-arrow)
|
||||
menu
|
||||
(λ (item evt) (tack/untack-callback arrows))))
|
||||
(unless (null? def-links)
|
||||
(let ([def-link (car def-links)])
|
||||
(make-object menu-item%
|
||||
jump-to-definition
|
||||
menu
|
||||
(λ (item evt)
|
||||
(jump-to-definition-callback def-link)))))
|
||||
(unless (null? var-arrows)
|
||||
(make-object menu-item%
|
||||
jump-to-next-bound-occurrence
|
||||
menu
|
||||
(λ (item evt) (jump-to-next-callback pos text arrows)))
|
||||
(make-object menu-item%
|
||||
jump-to-binding
|
||||
menu
|
||||
(λ (item evt) (jump-to-binding-callback arrows))))
|
||||
(unless (= start-selection end-selection)
|
||||
(let ([arrows-menu
|
||||
(make-object menu%
|
||||
"Arrows crossing selection"
|
||||
menu)]
|
||||
[callback
|
||||
(lambda (accept)
|
||||
(tack-crossing-arrows-callback
|
||||
arrow-record
|
||||
start-selection
|
||||
end-selection
|
||||
text
|
||||
accept))])
|
||||
(make-object menu-item%
|
||||
"Tack arrows"
|
||||
arrows-menu
|
||||
(lambda (item evt)
|
||||
(callback
|
||||
'(lexical top-level imported))))
|
||||
(make-object menu-item%
|
||||
"Tack non-import arrows"
|
||||
arrows-menu
|
||||
(lambda (item evt)
|
||||
(callback
|
||||
'(lexical top-level))))
|
||||
(make-object menu-item%
|
||||
"Untack arrows"
|
||||
arrows-menu
|
||||
(lambda (item evt)
|
||||
(untack-crossing-arrows
|
||||
arrow-record
|
||||
start-selection
|
||||
end-selection)))))
|
||||
(for-each (λ (f) (f menu)) add-menus)
|
||||
|
||||
(drracket:unit:add-search-help-desk-menu-item
|
||||
text
|
||||
menu
|
||||
pos
|
||||
(λ () (new separator-menu-item% [parent menu])))
|
||||
|
||||
menu)]))))))
|
||||
|
||||
(define/private (update-status-line eles)
|
||||
(let ([has-txt? #f])
|
||||
|
|
|
|||
|
|
@ -1395,7 +1395,7 @@
|
|||
(loop (list (syntax-source stx)
|
||||
(syntax-position stx)
|
||||
(syntax-span stx))))))))
|
||||
(define to-be-renamed (sort (hash-map all-stxs (λ (k v) k)) > #:key syntax-position))
|
||||
(define to-be-renamed (hash-map all-stxs (λ (k v) k)))
|
||||
(define do-renaming?
|
||||
(or (not (name-duplication? to-be-renamed id-sets new-sym))
|
||||
(equal?
|
||||
|
|
@ -1412,22 +1412,30 @@
|
|||
(when do-renaming?
|
||||
(unless (null? to-be-renamed)
|
||||
(let ([txts (list defs-text)])
|
||||
(define positions-to-rename
|
||||
(remove-duplicates
|
||||
(sort (map (λ (stx) (list (find-source-editor/defs stx defs-text)
|
||||
(syntax-position stx)
|
||||
(syntax-span stx)))
|
||||
to-be-renamed)
|
||||
>
|
||||
#:key cadr)))
|
||||
(send defs-text begin-edit-sequence)
|
||||
(for-each (λ (stx)
|
||||
(let ([source-editor (find-source-editor/defs stx defs-text)])
|
||||
(when (is-a? source-editor text%)
|
||||
(unless (memq source-editor txts)
|
||||
(send source-editor begin-edit-sequence)
|
||||
(set! txts (cons source-editor txts)))
|
||||
(let* ([start (- (syntax-position stx) 1)]
|
||||
[end (+ start (syntax-span stx))])
|
||||
(send source-editor delete start end #f)
|
||||
(send source-editor insert new-sym start start #f)))))
|
||||
to-be-renamed)
|
||||
(for ([info (in-list positions-to-rename)])
|
||||
(define source-editor (list-ref info 0))
|
||||
(define position (list-ref info 1))
|
||||
(define span (list-ref info 2))
|
||||
(when (is-a? source-editor text%)
|
||||
(unless (memq source-editor txts)
|
||||
(send source-editor begin-edit-sequence)
|
||||
(set! txts (cons source-editor txts)))
|
||||
(let* ([start (- position 1)]
|
||||
[end (+ start span)])
|
||||
(send source-editor delete start end #f)
|
||||
(send source-editor insert new-sym start start #f))))
|
||||
(send defs-text invalidate-bitmap-cache)
|
||||
(for-each
|
||||
(λ (txt) (send txt end-edit-sequence))
|
||||
txts)))))))
|
||||
(for ([txt (in-list txts)])
|
||||
(send txt end-edit-sequence))))))))
|
||||
|
||||
;; name-duplication? : (listof syntax) (listof id-set) symbol -> boolean
|
||||
;; returns #t if the name chosen would be the same as another name in this scope.
|
||||
|
|
|
|||
|
|
@ -144,7 +144,13 @@ module browser threading seems wrong.
|
|||
(set! added? #t)
|
||||
(new separator-menu-item% [parent menu]))))])
|
||||
|
||||
(add-search-help-desk-menu-item text menu event add-sep)
|
||||
(add-search-help-desk-menu-item text menu
|
||||
(let-values ([(x y)
|
||||
(send text dc-location-to-editor-location
|
||||
(send event get-x)
|
||||
(send event get-y))])
|
||||
(send text find-position x y))
|
||||
add-sep)
|
||||
|
||||
(when (is-a? text editor:basic<%>)
|
||||
(let-values ([(pos text) (send text get-pos/text event)])
|
||||
|
|
@ -181,20 +187,12 @@ module browser threading seems wrong.
|
|||
|
||||
(void))))))
|
||||
|
||||
(define (add-search-help-desk-menu-item text menu event [add-sep void])
|
||||
(define (add-search-help-desk-menu-item text menu position [add-sep void])
|
||||
(let* ([end (send text get-end-position)]
|
||||
[start (send text get-start-position)])
|
||||
(unless (= 0 (send text last-position))
|
||||
(let* ([str (if (= end start)
|
||||
(find-symbol
|
||||
text
|
||||
(call-with-values
|
||||
(λ ()
|
||||
(send text dc-location-to-editor-location
|
||||
(send event get-x)
|
||||
(send event get-y)))
|
||||
(λ (x y)
|
||||
(send text find-position x y))))
|
||||
(find-symbol text position)
|
||||
(send text get-text start end))]
|
||||
;; almost the same code as "search-help-desk" in "rep.rkt"
|
||||
[l (send text get-canvas)]
|
||||
|
|
|
|||
|
|
@ -627,19 +627,18 @@ all of the names in the tools library, for use defining keybindings
|
|||
|
||||
(proc-doc/names
|
||||
drracket:unit:add-search-help-desk-menu-item
|
||||
(->* ((is-a?/c text%) (is-a?/c menu-item-container<%>) (is-a?/c mouse-event%)) ((-> any)) void?)
|
||||
((text menu event)
|
||||
(->* ((is-a?/c text%) (is-a?/c menu-item-container<%>) exact-nonnegative-integer?) ((-> any)) void?)
|
||||
((text menu position)
|
||||
((add-sep void)))
|
||||
@{Assuming that @racket[event] represents a mouse click in @racket[text], this
|
||||
adds a menu item to @racket[menu] that searches in Help Desk
|
||||
for the text around the point where the click happened.
|
||||
|
||||
If there is only whitespace around the insertion point,
|
||||
then no @racket[menu-item%]s are added, and
|
||||
@racket[add-sep] is not called. If there is something to be
|
||||
added, then @racket[add-sep] is called before the menu item is
|
||||
created.
|
||||
})
|
||||
@{Adds a menu item to @racket[menu] that searches in Help Desk
|
||||
for the word around @racket[position] in @racket[text].
|
||||
|
||||
If there is only whitespace around @racket[position],
|
||||
then no @racket[menu-item%]s are added, and
|
||||
@racket[add-sep] is not called. If there is something to be
|
||||
added, then @racket[add-sep] is called before the menu item is
|
||||
created.
|
||||
})
|
||||
|
||||
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
#lang racket/base
|
||||
|
||||
#|
|
||||
|
||||
|
|
@ -5,15 +6,14 @@ tests involving object% are commented out, since they
|
|||
trigger runtime errors in check syntax.
|
||||
|
||||
|#
|
||||
#lang scheme/base
|
||||
|
||||
(require "drracket-test-util.rkt"
|
||||
string-constants/string-constant
|
||||
tests/utils/gui
|
||||
scheme/path
|
||||
scheme/class
|
||||
scheme/list
|
||||
scheme/file
|
||||
racket/path
|
||||
racket/class
|
||||
racket/list
|
||||
racket/file
|
||||
mred
|
||||
framework
|
||||
mrlib/text-string-style-desc)
|
||||
|
|
@ -24,8 +24,10 @@ trigger runtime errors in check syntax.
|
|||
;; type test = (make-test string
|
||||
;; (listof str/ann)
|
||||
;; (listof (cons (list number number) (listof (list number number)))))
|
||||
(define-struct test (input expected arrows))
|
||||
(define-struct (dir-test test) ())
|
||||
(define-struct test (input expected arrows) #:transparent)
|
||||
(define-struct (dir-test test) () #:transparent)
|
||||
|
||||
(define-struct rename-test (input pos old-name new-name output) #:transparent)
|
||||
|
||||
(define build-test
|
||||
(λ (input expected [arrow-table '()])
|
||||
|
|
@ -34,7 +36,6 @@ trigger runtime errors in check syntax.
|
|||
;; tests : (listof test)
|
||||
(define tests
|
||||
(list
|
||||
|
||||
(build-test "12345"
|
||||
'(("12345" constant)))
|
||||
(build-test "'abcdef"
|
||||
|
|
@ -877,7 +878,103 @@ trigger runtime errors in check syntax.
|
|||
(") " default-color)
|
||||
("#'" imported)
|
||||
("1))" default-color))
|
||||
(list '((27 33) (19 26) (36 49) (53 59) (64 66))))))
|
||||
(list '((27 33) (19 26) (36 49) (53 59) (64 66))))
|
||||
|
||||
(rename-test "(lambda (x) x)"
|
||||
9
|
||||
"x"
|
||||
"y"
|
||||
"(lambda (y) y)")
|
||||
|
||||
(rename-test "(lambda (x) x)"
|
||||
9
|
||||
"x"
|
||||
"yy"
|
||||
"(lambda (yy) yy)")
|
||||
|
||||
(rename-test "(lambda (x) x)"
|
||||
9
|
||||
"x"
|
||||
"yxy"
|
||||
"(lambda (yxy) yxy)")
|
||||
(rename-test "(lambda (x) x x)"
|
||||
9
|
||||
"x"
|
||||
"yxy"
|
||||
"(lambda (yxy) yxy yxy)")
|
||||
(rename-test "(lambda (x) x x)"
|
||||
12
|
||||
"x"
|
||||
"yxy"
|
||||
"(lambda (yxy) yxy yxy)")
|
||||
(rename-test "(lambda (x) x x)"
|
||||
14
|
||||
"x"
|
||||
"yxy"
|
||||
"(lambda (yxy) yxy yxy)")
|
||||
|
||||
(rename-test "(define-syntax-rule (m x) (λ (x) x))(m z)"
|
||||
39
|
||||
"z"
|
||||
"qq"
|
||||
"(define-syntax-rule (m x) (λ (x) x))(m qq)")
|
||||
|
||||
(rename-test (string-append
|
||||
"#lang racket"
|
||||
"\n"
|
||||
"(define player%\n"
|
||||
" (class object%\n"
|
||||
" (init-field strategy player# tiles)\n"
|
||||
" (field [score (set)])\n"
|
||||
"\n"
|
||||
" (super-new)\n"
|
||||
"\n"
|
||||
" (define/private (put t pl)\n"
|
||||
" (set! tiles(remove t tiles)))))\n")
|
||||
80
|
||||
"tiles"
|
||||
"*tiles"
|
||||
(string-append
|
||||
"#lang racket"
|
||||
"\n"
|
||||
"(define player%\n"
|
||||
" (class object%\n"
|
||||
" (init-field strategy player# *tiles)\n"
|
||||
" (field [score (set)])\n"
|
||||
"\n"
|
||||
" (super-new)\n"
|
||||
"\n"
|
||||
" (define/private (put t pl)\n"
|
||||
" (set! *tiles(remove t *tiles)))))\n"))
|
||||
|
||||
(rename-test (string-append
|
||||
"#lang racket"
|
||||
"\n"
|
||||
"(define player%\n"
|
||||
" (class object%\n"
|
||||
" (init-field strategy player# *tiles)\n"
|
||||
" (field [score (set)])\n"
|
||||
"\n"
|
||||
" (super-new)\n"
|
||||
"\n"
|
||||
" (define/private (put t pl)\n"
|
||||
" (set! *tiles(remove t *tiles)))))\n")
|
||||
80
|
||||
"*tiles"
|
||||
"tiles"
|
||||
(string-append
|
||||
"#lang racket"
|
||||
"\n"
|
||||
"(define player%\n"
|
||||
" (class object%\n"
|
||||
" (init-field strategy player# tiles)\n"
|
||||
" (field [score (set)])\n"
|
||||
"\n"
|
||||
" (super-new)\n"
|
||||
"\n"
|
||||
" (define/private (put t pl)\n"
|
||||
" (set! tiles(remove t tiles)))))\n"))))
|
||||
|
||||
|
||||
(define (main)
|
||||
(fire-up-drscheme-and-run-tests
|
||||
|
|
@ -917,45 +1014,76 @@ trigger runtime errors in check syntax.
|
|||
(define ((run-one-test save-dir) test)
|
||||
(set! total-tests-run (+ total-tests-run 1))
|
||||
(let* ([drs (wait-for-drscheme-frame)]
|
||||
[defs (queue-callback/res (λ () (send drs get-definitions-text)))]
|
||||
[input (test-input test)]
|
||||
[expected (test-expected test)]
|
||||
[arrows (test-arrows test)]
|
||||
[relative (find-relative-path save-dir (collection-path "mzlib"))])
|
||||
[defs (queue-callback/res (λ () (send drs get-definitions-text)))])
|
||||
(clear-definitions drs)
|
||||
(cond
|
||||
[(dir-test? test)
|
||||
(insert-in-definitions drs (format input (path->string relative)))]
|
||||
[else (insert-in-definitions drs input)])
|
||||
(click-check-syntax-button drs)
|
||||
(wait-for-computation drs)
|
||||
|
||||
(when (queue-callback/res (λ () (send defs in-edit-sequence?)))
|
||||
(error 'syncheck-test.rkt "still in edit sequence for ~s" input))
|
||||
|
||||
(let ([err (queue-callback/res (λ () (send drs syncheck:get-error-report-contents)))])
|
||||
(when err
|
||||
(fprintf (current-error-port)
|
||||
"FAILED ~s\n error report window is visible:\n ~a\n"
|
||||
input
|
||||
err)))
|
||||
|
||||
;; need to check for syntax error here
|
||||
(let ([got (get-annotated-output drs)])
|
||||
(compare-output (cond
|
||||
[(dir-test? test)
|
||||
(map (lambda (x)
|
||||
(list (if (eq? (car x) 'relative-path)
|
||||
(path->string relative)
|
||||
(car x))
|
||||
(cadr x)))
|
||||
expected)]
|
||||
[else
|
||||
expected])
|
||||
got
|
||||
arrows
|
||||
(queue-callback/res (λ () (send defs syncheck:get-bindings-table)))
|
||||
input))))
|
||||
[(test? test)
|
||||
(let ([input (test-input test)]
|
||||
[expected (test-expected test)]
|
||||
[arrows (test-arrows test)]
|
||||
[relative (find-relative-path save-dir (collection-path "mzlib"))])
|
||||
(cond
|
||||
[(dir-test? test)
|
||||
(insert-in-definitions drs (format input (path->string relative)))]
|
||||
[else (insert-in-definitions drs input)])
|
||||
(click-check-syntax-and-check-errors drs test)
|
||||
|
||||
;; need to check for syntax error here
|
||||
(let ([got (get-annotated-output drs)])
|
||||
(compare-output (cond
|
||||
[(dir-test? test)
|
||||
(map (lambda (x)
|
||||
(list (if (eq? (car x) 'relative-path)
|
||||
(path->string relative)
|
||||
(car x))
|
||||
(cadr x)))
|
||||
expected)]
|
||||
[else
|
||||
expected])
|
||||
got
|
||||
arrows
|
||||
(queue-callback/res (λ () (send defs syncheck:get-bindings-table)))
|
||||
input)))]
|
||||
[(rename-test? test)
|
||||
(insert-in-definitions drs (rename-test-input test))
|
||||
(click-check-syntax-and-check-errors drs test)
|
||||
(define menu-item
|
||||
(queue-callback/res
|
||||
(λ ()
|
||||
(define defs (send drs get-definitions-text))
|
||||
(define menu (send defs syncheck:build-popup-menu (rename-test-pos test) defs))
|
||||
(define item-name (format "Rename ~a" (rename-test-old-name test)))
|
||||
(define menu-item
|
||||
(for/or ([x (in-list (send menu get-items))])
|
||||
(and (is-a? x labelled-menu-item<%>)
|
||||
(equal? (send x get-label) item-name)
|
||||
x)))
|
||||
(cond
|
||||
[menu-item
|
||||
menu-item]
|
||||
[else
|
||||
(fprintf (current-error-port)
|
||||
"syncheck-test.rkt: rename test ~s didn't find menu item named ~s in ~s"
|
||||
test
|
||||
item-name
|
||||
(map (λ (x) (and (is-a? x labelled-menu-item<%>) (send x get-label)))
|
||||
(send menu get-items)))
|
||||
#f]))))
|
||||
(when menu-item
|
||||
(queue-callback (λ () (send menu-item command (make-object control-event% 'menu))))
|
||||
(wait-for-new-frame drs)
|
||||
(for ([x (in-string (rename-test-new-name test))])
|
||||
(test:keystroke x))
|
||||
(test:button-push "OK")
|
||||
(define result
|
||||
(queue-callback/res (λ ()
|
||||
(define defs (send drs get-definitions-text))
|
||||
(send defs get-text 0 (send defs last-position)))))
|
||||
(unless (equal? result (rename-test-output test))
|
||||
(fprintf (current-error-port)
|
||||
"syncheck-test.rkt FAILED\n test ~s\n got ~s\n"
|
||||
test
|
||||
result)))])))
|
||||
|
||||
|
||||
(define remappings
|
||||
|
|
@ -1044,6 +1172,19 @@ trigger runtime errors in check syntax.
|
|||
(define (get-annotated-output drs)
|
||||
(queue-callback/res (λ () (get-string/style-desc (send drs get-definitions-text)))))
|
||||
|
||||
(define (click-check-syntax-and-check-errors drs test)
|
||||
(click-check-syntax-button drs)
|
||||
(wait-for-computation drs)
|
||||
(when (queue-callback/res (λ () (send (send drs get-definitions-text) in-edit-sequence?)))
|
||||
(error 'syncheck-test.rkt "still in edit sequence for ~s" test))
|
||||
|
||||
(let ([err (queue-callback/res (λ () (send drs syncheck:get-error-report-contents)))])
|
||||
(when err
|
||||
(fprintf (current-error-port)
|
||||
"FAILED ~s\n error report window is visible:\n ~a\n"
|
||||
test
|
||||
err))))
|
||||
|
||||
(define (click-check-syntax-button drs)
|
||||
(test:run-one (lambda () (send (send drs syncheck:get-button) command))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user