67 lines
1.4 KiB
Scheme
67 lines
1.4 KiB
Scheme
|
|
(when (not (defined? 'test))
|
|
(load-relative "testing.ss"))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Editor Tests ;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;; Undo tests
|
|
|
|
(define e (make-object text%))
|
|
(stv e insert "Hello")
|
|
(st #t e is-modified?)
|
|
(stv e undo)
|
|
(st #f e is-modified?)
|
|
(stv e redo)
|
|
(st #t e is-modified?)
|
|
(stv e set-modified #f)
|
|
(st #f e is-modified?)
|
|
(stv e undo)
|
|
(st #t e is-modified?)
|
|
(stv e redo)
|
|
(st #f e is-modified?)
|
|
(stv e undo)
|
|
(st #t e is-modified?)
|
|
(stv e redo)
|
|
(st #f e is-modified?)
|
|
(stv e undo)
|
|
(stv e set-modified #f)
|
|
(st #f e is-modified?)
|
|
(stv e redo)
|
|
(st #t e is-modified?)
|
|
(st "Hello" e get-text)
|
|
(define undone? #f)
|
|
(stv e add-undo (letrec ([f (lambda ()
|
|
(set! undone? #t)
|
|
(send e add-undo f) ; reinstall self!
|
|
#f)])
|
|
f))
|
|
(stv e undo)
|
|
(st "Hello" e get-text)
|
|
(test #t 'undone? undone?)
|
|
(stv e undo)
|
|
(st "" e get-text)
|
|
(set! undone? #f)
|
|
(stv e redo)
|
|
(st "Hello" e get-text)
|
|
(test #f 'undone? undone?)
|
|
(stv e redo)
|
|
(st "Hello" e get-text)
|
|
(test #t 'undone? undone?)
|
|
(set! undone? #f)
|
|
(stv e redo)
|
|
(st "Hello" e get-text)
|
|
(test #f 'undone? undone?)
|
|
(stv e insert "x")
|
|
(st "Hellox" e get-text)
|
|
(stv e add-undo (lambda ()
|
|
(set! undone? #t)
|
|
#t)) ; do next one, too
|
|
(stv e undo)
|
|
(test #t 'undone? undone?)
|
|
(st "Hello" e get-text)
|
|
|
|
|
|
(report-errs)
|