169 lines
7.1 KiB
Racket
169 lines
7.1 KiB
Racket
#lang racket/base
|
|
(require (for-syntax racket/base)
|
|
"test-suite-utils.rkt")
|
|
|
|
(module test racket/base)
|
|
|
|
(define-syntax (test-search stx)
|
|
(syntax-case stx ()
|
|
[(_ args ...)
|
|
(with-syntax ([line (syntax-line stx)])
|
|
#'(test-search/proc line args ...))]))
|
|
|
|
;; creates a search text, binds it to 't' and then,
|
|
;; for each expression in 'commands', evaluates it in a let
|
|
;; binding 't'. In between each call to commands, it waits
|
|
;; for the search text to quiesce and then finally gets
|
|
;; the search bubbles, comparing them to 'bubble-table'
|
|
(define (test-search/proc line commands bubble-table)
|
|
;(printf "running test on line ~s\n" line)
|
|
(test
|
|
(string->symbol (format "search.rkt: line ~a pos immediately" line))
|
|
(lambda (x) (equal? bubble-table x))
|
|
(lambda ()
|
|
(send-sexp-to-mred
|
|
`(let ([c (make-channel)])
|
|
(queue-callback
|
|
(λ () (channel-put c (new (text:searching-mixin (editor:keymap-mixin text:basic%))))))
|
|
(define t (channel-get c))
|
|
(define (wait)
|
|
(let loop ()
|
|
(queue-callback
|
|
(λ ()
|
|
(channel-put c (send t search-updates-pending?)))
|
|
#f)
|
|
(when (channel-get c)
|
|
(loop))))
|
|
,@(apply
|
|
append
|
|
(for/list ([command (in-list commands)])
|
|
(list `(queue-callback (λ () ,command (channel-put c #f)))
|
|
'(channel-get c)
|
|
'(wait))))
|
|
(queue-callback
|
|
(λ ()
|
|
(channel-put c (send t get-search-bubbles)))
|
|
#f)
|
|
(channel-get c))))))
|
|
|
|
(test-search (list '(begin (send t insert "")
|
|
(send t set-searching-state "aba" #t #f)
|
|
(send t set-position 0 0)))
|
|
'())
|
|
(test-search (list '(begin (send t insert "")
|
|
(send t set-searching-state "aba" #t #f))
|
|
'(send t set-position 0 0))
|
|
'())
|
|
(test-search (list '(begin (send t insert "aba")
|
|
(send t set-searching-state "aba" #t #f)
|
|
(send t set-position 0 0)))
|
|
`(((0 . 3) normal-search-color)))
|
|
(test-search (list '(begin (send t insert "aba")
|
|
(send t set-searching-state "aba" #t #f) )
|
|
'(send t set-position 0 0))
|
|
`(((0 . 3) normal-search-color)))
|
|
|
|
(test-search (list '(begin (send t insert "aba aba")
|
|
(send t set-searching-state "aba" #t #f)
|
|
(send t set-position 0 0)))
|
|
`(((0 . 3) normal-search-color)
|
|
((4 . 3) normal-search-color)))
|
|
(test-search (list '(begin (send t insert "aba aba")
|
|
(send t set-searching-state "aba" #t #f))
|
|
'(send t set-position 0 0))
|
|
`(((0 . 3) normal-search-color)
|
|
((4 . 3) normal-search-color)))
|
|
|
|
|
|
(test-search (list '(begin (send t insert "abaaba")
|
|
(send t set-searching-state "aba" #t #f)
|
|
(send t set-position 0 0)))
|
|
`(((0 . 3) normal-search-color)
|
|
((3 . 3) normal-search-color)))
|
|
(test-search (list '(begin (send t insert "abaaba")
|
|
(send t set-searching-state "aba" #t #f))
|
|
'(send t set-position 0 0))
|
|
`(((0 . 3) normal-search-color)
|
|
((3 . 3) normal-search-color)))
|
|
|
|
(test-search (list '(begin (send t insert "abababa")
|
|
(send t set-searching-state "aba" #t #f)
|
|
(send t set-position 0 0)))
|
|
`(((0 . 3) normal-search-color)
|
|
((4 . 3) normal-search-color)))
|
|
(test-search (list '(begin (send t insert "abababa")
|
|
(send t set-searching-state "aba" #t #f))
|
|
'(send t set-position 0 0))
|
|
`(((0 . 3) normal-search-color)
|
|
((4 . 3) normal-search-color)))
|
|
|
|
(test-search (list '(begin (send t insert "Aba")
|
|
(send t set-searching-state "aba" #t #f)
|
|
(send t set-position 0 0)))
|
|
'())
|
|
(test-search (list '(begin (send t insert "Aba")
|
|
(send t set-searching-state "aba" #t #f))
|
|
'(send t set-position 0 0))
|
|
'())
|
|
(test-search (list '(begin (send t insert "Aba")
|
|
(send t set-searching-state "aba" #f #f)
|
|
(send t set-position 0 0)))
|
|
`(((0 . 3) normal-search-color)))
|
|
(test-search (list '(begin (send t insert "Aba")
|
|
(send t set-searching-state "aba" #f #f))
|
|
'(send t set-position 0 0))
|
|
`(((0 . 3) normal-search-color)))
|
|
|
|
(test-search (list '(begin (send t set-searching-state "aba" #t 0)
|
|
(send t set-position 0)))
|
|
'())
|
|
|
|
(test-search (list '(begin (send t insert "aba")
|
|
(send t set-searching-state "aba" #f #t)
|
|
(send t set-position 0 0)))
|
|
`(((0 . 3) dark-search-color)))
|
|
(test-search (list '(begin (send t insert "aba")
|
|
(send t set-searching-state "aba" #f #t))
|
|
'(send t set-position 0 0))
|
|
`(((0 . 3) dark-search-color)))
|
|
|
|
(test-search (list '(begin (send t insert "abababa")
|
|
(send t set-searching-state "aba" #f #t)
|
|
(send t set-position 0 0)))
|
|
`(((0 . 3) dark-search-color)
|
|
((4 . 3) light-search-color)))
|
|
(test-search (list '(begin (send t insert "abababa")
|
|
(send t set-searching-state "aba" #f #t))
|
|
'(send t set-position 0 0))
|
|
`(((0 . 3) dark-search-color)
|
|
((4 . 3) light-search-color)))
|
|
|
|
(test-search (list '(begin (send t insert "aba aba aba")
|
|
(send t set-searching-state "aba" #f #t)
|
|
(send t set-position 1 1)))
|
|
`(((0 . 3) light-search-color)
|
|
((4 . 3) dark-search-color)
|
|
((8 . 3) light-search-color)))
|
|
(test-search (list '(begin (send t insert "aba aba aba")
|
|
(send t set-searching-state "aba" #f #t))
|
|
'(send t set-position 1 1))
|
|
`(((0 . 3) light-search-color)
|
|
((4 . 3) dark-search-color)
|
|
((8 . 3) light-search-color)))
|
|
|
|
(test-search (list '(begin (send t insert "aba")
|
|
(send t set-searching-state "aba" #f #t))
|
|
'(send t set-position 0 0)
|
|
'(send t set-position 3 3))
|
|
`(((0 . 3) light-search-color)))
|
|
(test-search (list '(begin (send t insert "aba")
|
|
(send t set-searching-state "aba" #f #t))
|
|
'(send t set-position 0 0)
|
|
'(send t set-position 1 1))
|
|
`(((0 . 3) light-search-color)))
|
|
|
|
(test-search (list '(begin (send t insert "aba")
|
|
(send t set-searching-state "aba" #f #t))
|
|
'(send t set-searching-state #f #f #f))
|
|
`())
|