From 63a7a9c77bedb8f2d7c5f862c20bf7716c95be26 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 19 May 2009 00:27:39 +0000
Subject: [PATCH] more random mred testing

svn: r14863
---
 collects/tests/mred/wxme-random.ss | 63 ++++++++++++++++++------------
 1 file changed, 39 insertions(+), 24 deletions(-)

diff --git a/collects/tests/mred/wxme-random.ss b/collects/tests/mred/wxme-random.ss
index 31ed15c1f5..685d89dc00 100644
--- a/collects/tests/mred/wxme-random.ss
+++ b/collects/tests/mred/wxme-random.ss
@@ -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)))
-
-   
\ No newline at end of file