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

more random mred testing

Browse Source 
svn: r14863
This commit is contained in:
Matthew Flatt 2009-05-19 00:27:39 +00:00
parent c4b4af817b
commit 63a7a9c77b
1 changed files with 39 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
collects/tests/mred/wxme-random.ss
View File

@ -1,20 +1,24 @@
#lang scheme/gui
(define seed 704050726 #;(abs (current-milliseconds)))
(define seed 700438844 #;(abs (current-milliseconds)))
(random-seed seed)
(define t (new text%))
; scroll-line-location bug
(define orig-t (new text%))
(define frame
(new frame% [label "Test"]
[width 300]
[height 400]))
(define canvas
(new editor-canvas% [parent frame] [editor t]))
(new editor-canvas% [parent frame] [editor orig-t]))
(send frame show #t)
(send t set-max-undo-history 100)
(define (init t)
(send t set-max-undo-history 100))
(init orig-t)
(define (random-elem v)
(vector-ref v (random (vector-length v))))
@ -22,40 +26,51 @@
(define (random-string)
(random-elem '#("a" "x\ny\nz\n" "hello there")))
(define seq 0)
(define seqs (make-hasheq))
(define ts (make-weak-hasheq))
(define actions
(vector
(lambda () (send t undo))
(lambda () (send t redo))
(lambda () (send t insert (random-string) (random (add1 (send t last-position)))))
(lambda ()
(lambda (t) (send t undo))
(lambda (t) (send t redo))
(lambda (t) (send t insert (random-string) (random (add1 (send t last-position)))))
(lambda (t)
(let ([pos (random (add1 (send t last-position)))])
(send t delete pos (random (max 1 (- (send t last-position) pos))))))
(lambda ()
(lambda (t)
(send t begin-edit-sequence)
(set! seq (add1 seq)))
(lambda ()
(hash-update! seqs t add1 0))
(lambda (t)
(let loop ()
(when (positive? seq)
(when (positive? (hash-ref seqs t 0))
(send t end-edit-sequence)
(set! seq (sub1 seq))
(hash-update! seqs t sub1)
(when (zero? (random 2))
(loop)))))
(lambda ()
(lambda (t)
(let ([pos (random (add1 (send t last-position)))])
(send t set-position pos (random (max 1 (- (send t last-position) pos))))))
(lambda () (send t copy))
(lambda () (send t cut))
(lambda () (send t paste))
(lambda () (send t change-style (make-object style-delta% 'change-size (add1 (random 42)))))
(lambda () (send t insert (make-object editor-snip%)))
(lambda (t) (send t copy))
(lambda (t) (send t cut))
(lambda (t) (send t paste))
(lambda (t) (send t change-style (make-object style-delta% 'change-size (add1 (random 42)))))
(lambda (t)
(let ([t2 (new text%)])
(hash-set! ts t2 #t)
(init t2)
(send t insert (make-object editor-snip% t2))))
(lambda (t)
(send t set-max-width (if (zero? (random 2)) 100.0 'none)))
))
(let loop ()
(let ([act (random-elem actions)])
(let ([act (random-elem actions)]
[t (if (zero? (random 2))
orig-t
(for/fold ([t orig-t])
([t (in-hash-keys ts)]
[n (in-range (random (add1 (hash-count ts))))])
t))])
(printf "~s: ~s\n" seed act)
(act)
(act t)
(loop)))