run test in its own eventspace to adjust for change in running worlds and universes

pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-in-draw.rkt

@@ -1,7 +1,6 @@
 #lang racket
 
-(require 2htdp/universe)
-(require 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define (f x)
   (cond
@@ -11,23 +10,25 @@
 
 (define txt "all questions were #f")
 
-(with-handlers ([exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))])
-  (big-bang 0 (on-tick add1) (to-draw f))
-  (error 'error-in-draw "test failed"))
+(testing
+
+  (with-handlers ([exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))])
+    (big-bang 0 (on-tick add1) (to-draw f))
+    (error 'error-in-draw "test failed"))
 
 
-(let ([exn (with-handlers ([exn:fail? values])
-             (big-bang #f 
-                       [to-draw (λ (a b) #f)])
-             "no error raised")])
-(unless (regexp-match #rx"^to-draw:" (exn-message exn))
-  (eprintf "expected a error message beginning with to-draw:\n")
-  (raise exn)))
+  (let ([exn (with-handlers ([exn:fail? values])
+	       (big-bang #f 
+		 [to-draw (λ (a b) #f)])
+	       "no error raised")])
+    (unless (regexp-match #rx"^to-draw:" (exn-message exn))
+      (eprintf "expected a error message beginning with to-draw:\n")
+      (raise exn)))
 
-(let ([exn (with-handlers ([exn:fail? values])
-             (big-bang #f 
-                       [on-draw (λ (a b) #f)])
-             "no error raised")])
-(unless (regexp-match #rx"^on-draw:" (exn-message exn))
-  (eprintf "expected a error message beginning with on-draw:\n")
-  (raise exn)))
+  (let ([exn (with-handlers ([exn:fail? values])
+	       (big-bang #f 
+		 [on-draw (λ (a b) #f)])
+	       "no error raised")])
+    (unless (regexp-match #rx"^on-draw:" (exn-message exn))
+      (eprintf "expected a error message beginning with on-draw:\n")
+      (raise exn))))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-in-tick.rkt

@@ -1,7 +1,6 @@
 #lang racket
 
-(require 2htdp/universe)
-(require 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define (f x) (circle 10 'solid 'red))
 
@@ -12,6 +11,7 @@
 
 (define txt "all questions were #f")
 
-(with-handlers ([exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))])
-  (big-bang 0 (on-tick g) (to-draw f))
-  (error 'error-in-tick "test failed"))
+(testing
+  (with-handlers ([exn? (lambda (e) (unless (string=? (exn-message e) txt) (raise e)))])
+    (big-bang 0 (on-tick g) (to-draw f))
+    (error 'error-in-tick "test failed")))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/full-scene-visible.rkt

@@ -1,6 +1,7 @@
 #lang scheme/base
 
 (require 2htdp/universe
+         "test-aux.rkt"
          (prefix-in 2: 2htdp/image)
          (prefix-in 1: htdp/image))
 
@@ -10,6 +11,6 @@
             (stop-when zero?)
             (on-draw (λ (x) (f 100 100 'outline 'black)))))
 
-(see-full-rectangle 3 2:rectangle)
-
-(see-full-rectangle 3 1:rectangle)
+(testing 
+  (see-full-rectangle 3 2:rectangle)
+  (see-full-rectangle 3 1:rectangle))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/image-too-large.rkt

@@ -1,6 +1,6 @@
 #lang racket
 
-(require 2htdp/universe 2htdp/image rackunit)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define width 100000)
 (define height 10)
@@ -10,31 +10,31 @@
 (define (draw-large i)
   image)
 
-(check-true
- (with-handlers ([exn:fail? (lambda (x)
-                              (define msg (exn-message x))
-                              (define reg (regexp-match "draw-large" msg))
-                              (pair? reg))])
-   (big-bang 0 (to-draw draw-large) (on-tick add1) (stop-when zero?))
-   #false))
+(testing
+  (check-true
+    (with-handlers ([exn:fail? (lambda (x)
+				 (define msg (exn-message x))
+				 (define reg (regexp-match "draw-large" msg))
+				 (pair? reg))])
+      (big-bang 0 (to-draw draw-large) (on-tick add1) (stop-when zero?))
+      #false))
 
+  (check-true
+    (with-handlers ([exn:fail? (lambda (x)
+				 (define msg (exn-message x))
+				 (define reg (regexp-match "to-draw" msg))
+				 (pair? reg))])
+      (big-bang 0
+	(to-draw draw-large width height)
+	(on-tick add1)
+	(stop-when zero?))
+      #false))
 
-(check-true
- (with-handlers ([exn:fail? (lambda (x)
-                              (define msg (exn-message x))
-                              (define reg (regexp-match "to-draw" msg))
-                              (pair? reg))])
-   (big-bang 0
-             (to-draw draw-large width height)
-             (on-tick add1)
-             (stop-when zero?))
-   #false))
-
-(check-true
- (local ((define first-time #true))
-   (big-bang 0
-             (to-draw (lambda (_) (begin0 (if first-time small image) (set! first-time #false))))
-             (on-tick add1)
-             (stop-when zero?))
-   #true))
+  (check-true
+    (local ((define first-time #true))
+      (big-bang 0
+	(to-draw (lambda (_) (begin0 (if first-time small image) (set! first-time #false))))
+	(on-tick add1)
+	(stop-when zero?))
+      #true)))
 

pkgs/htdp-pkgs/htdp-test/2htdp/tests/key-error.rkt

@@ -3,8 +3,7 @@
 ;; ---------------------------------------------------------------------------------------------------
 ;; the error message should refer to the 'on-tick handler, not the lambda in the clause 
 
-(require 2htdp/universe)
-(require 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define (main)
   (big-bang 0
@@ -12,24 +11,26 @@
             (to-draw (lambda (w) (circle 10 'solid 'red)))
             (check-with number?)))
 
-(with-handlers ((exn:fail? (lambda (x) 
-                             (define msg (exn-message x))
-                             (define hdl (regexp-match "check-with: (.*) returned" msg))
-                             (unless (and hdl (cons? (regexp-match "on-tick" (second hdl))))
-                               (error 'test "expected: \"on-tick\", actual: ~e" (second hdl))))))
-  (main))
+(testing
+
+  (with-handlers ((exn:fail? (lambda (x) 
+			       (define msg (exn-message x))
+			       (define hdl (regexp-match "check-with: (.*) returned" msg))
+			       (unless (and hdl (cons? (regexp-match "on-tick" (second hdl))))
+				 (error 'test "expected: \"on-tick\", actual: ~e" (second hdl))))))
+    (main))
 
 
-(define (my-fun x) "hi")
+  (define (my-fun x) "hi")
 
-(with-handlers ((exn:fail? 
-                 (lambda (x) 
-                   (define msg (exn-message x))
-                   (define hdl (regexp-match "check-with's handler test" msg))
-                   (unless hdl
-                     (error 'test "expected: \"check-with's handler test, error says: ~e" msg)))))
-  (big-bang 0 
-            [to-draw (lambda (x) (circle 1 'solid 'red))]
-            [on-tick (lambda (x) (my-fun x))]
-            [check-with (lambda (x) (number? x))])
-  (raise `(bad "must fail")))
+  (with-handlers ((exn:fail? 
+		    (lambda (x) 
+		      (define msg (exn-message x))
+		      (define hdl (regexp-match "check-with's handler test" msg))
+		      (unless hdl
+			(error 'test "expected: \"check-with's handler test, error says: ~e" msg)))))
+    (big-bang 0 
+      [to-draw (lambda (x) (circle 1 'solid 'red))]
+      [on-tick (lambda (x) (my-fun x))]
+      [check-with (lambda (x) (number? x))])
+    (raise `(bad "must fail"))))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/mouse-evt.rkt

@@ -2,7 +2,7 @@
 
 (require 2htdp/universe)
 (require htdp/image)
-(require test-engine/scheme-tests)
+(require "test-aux.rkt")
 
 (define-struct posn (x y) #:transparent)
 
@@ -24,8 +24,6 @@
     [else
      (place-image sq (posn-x a-world) (posn-y a-world) mt)]))
 
-(check-expect (mouse-handler 'w 100 100 "leave") (make-posn 250 250))
-
 (define (mouse-handler w x y me)
   (cond
     [(string=? "button-down" me) w]
@@ -41,6 +39,7 @@
 (define (main w)
   (big-bang world1 (on-draw draw) (stop-when out?) (on-mouse mouse-handler)))
 
-(test)
+(check-equal? (mouse-handler 'w 100 100 "leave") (make-posn 250 250))
 
-(main 0)
+(testing
+  (main 0))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/on-release-no-key.rkt

@@ -5,6 +5,7 @@
 
 (require 2htdp/image) 
 (require 2htdp/universe)
+(require "test-aux.rkt")
 
 (define large 50)
 
@@ -17,8 +18,9 @@
 
 (define (deflate b) (max (- b 1) 1))
 
-(big-bang 20
-          (on-release blow-up)
-          (on-tick deflate)
-          (to-draw balloon 200 200)
-          (stop-when (lambda (w) (>= w large))))
+(testing
+  (big-bang 20
+    (on-release blow-up)
+    (on-tick deflate)
+    (to-draw balloon 200 200)
+    (stop-when (lambda (w) (>= w large)))))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/on-tick-with-limit.rkt

@@ -1,7 +1,8 @@
 #lang racket 
 
-(require 2htdp/universe 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
-(big-bang 0 
-          (on-tick add1 1/28 3)
-          (to-draw (lambda (w) (circle (- 100 w) 'solid 'red))))
+(testing
+  (big-bang 0 
+    (on-tick add1 1/28 3)
+    (to-draw (lambda (w) (circle (- 100 w) 'solid 'red)))))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/pad1-in-bsl.rkt

@@ -5,6 +5,7 @@
 
 (require 2htdp/universe)
 (require 2htdp/image)
+(require "test-aux.rkt")
 
 (define (render x)
   (place-image (circle 3 'solid 'red) (+ 150 (real-part x)) (+ 150 (imag-part x)) (empty-scene 300 300)))
@@ -12,7 +13,8 @@
 (define (sub1-i x) (- x 0+i))
 (define (add1-i x) (+ x 0+i))
 
-(big-bang 0+0i
-          (to-draw render)
-          (on-tick add1-i 1/28 50)
-          (on-pad (pad-handler (up sub1-i) (down add1-i) (left sub1) (right add1))))
+(testing
+  (big-bang 0+0i
+    (to-draw render)
+    (on-tick add1-i 1/28 50)
+    (on-pad (pad-handler (up sub1-i) (down add1-i) (left sub1) (right add1)))))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/pad1.rkt

@@ -1,6 +1,6 @@
 #lang racket/gui
 
-(require 2htdp/image 2htdp/universe)
+(require 2htdp/image 2htdp/universe "test-aux.rkt")
 
 (pad=? "left" "left")
 
@@ -57,8 +57,9 @@
   (begin (set! label (string-append txt label))
          (big-bang x0 (to-draw render) (on-pad phandler) clause ... )))
 
-(= -10-10i (run ""))
-(= -10-10i (run "press l, " (on-key (key-handler 'key))))
-(= -10-10i (run "press l, " (on-key (key-handler 'key)) (on-release (key-handler 'release))))
-(= -10-10i (run "press l, " (on-release (key-handler 'release))))
+(testing
+  (= -10-10i (run ""))
+  (= -10-10i (run "press l, " (on-key (key-handler 'key))))
+  (= -10-10i (run "press l, " (on-key (key-handler 'key)) (on-release (key-handler 'release))))
+  (= -10-10i (run "press l, " (on-release (key-handler 'release)))))
 

pkgs/htdp-pkgs/htdp-test/2htdp/tests/perform-robby.rkt

@@ -1,5 +1,5 @@
 #lang scheme
-(require 2htdp/universe 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define (slow)
   (let sloop ([n (expt 2 22)])
@@ -13,9 +13,10 @@
 (define (render w)
   (circle 30 'solid (if (odd? w) 'red 'green)))
 
-(big-bang 10
-          (on-tick update-world)
-          (on-draw render)
-          (stop-when zero?))
+(testing 
+  (big-bang 10
+    (on-tick update-world)
+    (on-draw render)
+    (stop-when zero?))
 
-(printf "done\n")
+  (printf "done\n"))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/random-seed-works.rkt

@@ -1,6 +1,9 @@
 #lang racket
 
-(require 2htdp/universe 2htdp/image rackunit)
+;; testing the combination of random-seed and world programming 
+;; -----------------------------------------------------------------------------
+
+(require 2htdp/universe 2htdp/image)
 
 (define (main)
   (random-seed 1324)
@@ -11,12 +14,21 @@
    ;; it fails mostly with just time but not always, strange 
    
    (to-draw (λ (l) 
-              (text (if (> (length l) 3) "ok" (~a "press a again: " (- 2 (length l)))) 222 *color)))
+              (text (if (> (length l) 3)
+			"ok"
+			(~a "press a again: " (- 2 (length l))))
+		    222
+		    *color)))
+   
    (on-key (λ (l ke) 
              (if (and (key=? "a" ke) (<= (length l) 3)) (cons (random 100) l) l)))
+   
    (stop-when (λ (l) (>= (length l) 2)))))
+
 (define *color 'blue)
 
-(check-equal? (main) (begin (set! *color 'red) (main)))
+;; -----------------------------------------------------------------------------
+(require "test-aux.rkt")
 
-(module test racket/base)
+(testing
+  (check-equal? (main) (begin (set! *color 'red) (main))))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/record-stop-when.rkt

@@ -1,7 +1,8 @@
 #lang racket
 
 (require 2htdp/universe 2htdp/image (only-in lang/imageeq image=?) 
-         racket/runtime-path)
+         racket/runtime-path
+	 "test-aux.rkt")
 
 (define (draw-number n)
   (place-image (text (number->string n) 44 'red) 50 50 (empty-scene 100 100)))
@@ -11,24 +12,26 @@
 (define stop (text "STOP" 44 'red))
 
 (define-runtime-path dir "images0")
-(unless (directory-exists? dir)
-  (make-directory dir))
-(parameterize ([current-directory dir])
-  (for-each delete-file (directory-list)))
-(with-output-to-file (build-path dir "index.html")
-  (lambda ()
-    (displayln "<html><body><img src=\"i-animated.gif\" /></body></html>"))
-  #:exists 'replace)
-(define final-world 
-  (big-bang 0
-            (on-tick add1)
-            (stop-when (curry = 5) draw-stop)
-            (on-draw draw-number)
-            (record? dir)))
-(sleep 1)
 
-(define i (bitmap "images0/i1.png"))
-(define j (draw-stop 5))
+(testing
+  (unless (directory-exists? dir)
+    (make-directory dir))
+  (parameterize ([current-directory dir])
+    (for-each delete-file (directory-list)))
+  (with-output-to-file (build-path dir "index.html")
+    (lambda ()
+      (displayln "<html><body><img src=\"i-animated.gif\" /></body></html>"))
+    #:exists 'replace)
+  (define final-world 
+    (big-bang 0
+      (on-tick add1)
+      (stop-when (curry = 5) draw-stop)
+      (on-draw draw-number)
+      (record? dir)))
+  (sleep 1)
 
-(unless (image=? (crop 0 0 100 100 i) j)
-  (eprintf "this test needs to be revised -- the way 'world' writes images adds an extra pixel -- think! \n"))
+  (define i (bitmap "images0/i1.png"))
+  (define j (draw-stop 5))
+
+  (unless (image=? (crop 0 0 100 100 i) j)
+    (eprintf "this test needs to be revised -- the way 'world' writes images adds an extra pixel -- think! \n")))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/record.rkt

@@ -1,7 +1,6 @@
 #lang racket
 
-(require 2htdp/universe)
-(require 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define (draw-number n)
   (place-image (text (number->string n) 44 'red)
@@ -37,5 +36,6 @@
     (error 'record? "(~s, ~s) didn't record proper number of images: ~s" n dir 
            number-of-png)))
 
-(create-n-images 3 3 "images3/")
-(create-n-images 0 0 "images0/")
+(testing
+  (create-n-images 3 3 "images3/")
+  (create-n-images 0 0 "images0/"))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/release.rkt

@@ -1,7 +1,6 @@
 #lang scheme 
 
-(require 2htdp/universe)
-(require 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define (main r)
   (big-bang 1
@@ -14,7 +13,7 @@
                      r)
 	    (stop-when (lambda (x)
 			 (if (string? x)
-			     (>= (string-length x) 10)
+			     (>= (string-length x) 3)
 			     (>= x 5))))
             (on-key  (lambda (n key)
                        (if (string? n)
@@ -27,4 +26,4 @@
                           (if (key=? "a" key) 
                               1
                               n)))))
-(main 1)
+(testing (main 1))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/run-movie.rkt

@@ -1,6 +1,6 @@
 #lang racket
 
-(require 2htdp/universe 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define (make-images i)
   (cond
@@ -10,4 +10,4 @@
 (define DOT (circle 3 'solid 'red))
 (define BACKGROUND (empty-scene 100 400))
 
-(run-movie 1/8 (make-images 8))
+(testing (run-movie 1/8 (make-images 8)))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/ufo-rename.rkt

@@ -1,6 +1,7 @@
 #lang scheme
 (require (prefix-in uni: 2htdp/universe)
-         (prefix-in uni: htdp/image))
+         (prefix-in uni: htdp/image)
+	 "test-aux.rkt")
 
 (define (create-UFO-scene height)
   (uni:place-image UFO 50 height (uni:empty-scene 100 100)))
@@ -9,7 +10,8 @@
   (uni:overlay (uni:circle 10 'solid 'green)
                (uni:rectangle 40 4 'solid 'green)))
 
-(uni:big-bang 0
-              (uni:on-tick add1)
-	      (uni:stop-when (lambda (y) (>= y 100)))
-              (uni:on-draw create-UFO-scene))
+(testing
+  (uni:big-bang 0
+    (uni:on-tick add1)
+    (uni:stop-when (lambda (y) (>= y 100)))
+    (uni:on-draw create-UFO-scene)))

pkgs/htdp-pkgs/htdp-test/2htdp/tests/world0-stops.rkt

@@ -3,8 +3,7 @@
 ;; ---------------------------------------------------------------------------------------------------
 ;; does big-bang stop when the initial world is already a final world? does it draw the final image? 
 
-(require 2htdp/universe)
-(require 2htdp/image)
+(require 2htdp/universe 2htdp/image "test-aux.rkt")
 
 (define ((draw message) x)
   (display message) 
@@ -20,8 +19,7 @@
     (unless (string=? actual-output expected-output)
       (error 'failure "~a expected output ~e, output produced ~e" 'test expected-output actual-output))))
 
-(test (big-bang 0 (stop-when zero?) (on-tick add1) (to-draw (draw ""))) 0 "")
-
-(test (big-bang (stop-with 0) (on-tick add1) (to-draw (draw ""))) 0 "")
-
-(test (big-bang 0 (on-draw (draw 0)) (stop-when zero? (draw 1))) 0 "1")
+(testing
+  (test (big-bang 0 (stop-when zero?) (on-tick add1) (to-draw (draw ""))) 0 "")
+  (test (big-bang (stop-with 0) (on-tick add1) (to-draw (draw ""))) 0 "")
+  (test (big-bang 0 (on-draw (draw 0)) (stop-when zero? (draw 1))) 0 "1"))