From 17a48546f8111d2010d9845444fb589d1e086573 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Wed, 9 Jan 2013 17:46:21 -0500 Subject: [PATCH] universe restart test, bug from Marco (cherry picked from commit 7df831feeca009d3bc80b0859eb3cebb072a0451) --- collects/2htdp/tests/universe-restart.rkt | 45 +++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 collects/2htdp/tests/universe-restart.rkt diff --git a/collects/2htdp/tests/universe-restart.rkt b/collects/2htdp/tests/universe-restart.rkt new file mode 100644 index 0000000000..9d741f4f1d --- /dev/null +++ b/collects/2htdp/tests/universe-restart.rkt @@ -0,0 +1,45 @@ +#lang racket + +(module drop-on-message racket + (require 2htdp/universe 2htdp/image) + + (define (u) + (universe 0 + (on-new (lambda (u w) (make-bundle (+ u 1) '() '()))) + (on-msg (lambda (u w m) (make-bundle (- u 1) '() (list w)))) + (state #t))) + + (define (w n) + (big-bang 3 + [to-draw (lambda (w) (overlay (text (number->string w) 22 'black) (circle 100 'solid 'red)))] + [on-tick (lambda (w) (if (<= w 1) (make-package 0 n) (- w 1)))] + [register LOCALHOST] + [name n])) + + (launch-many-worlds (u) (w "one") (w "two"))) + +(require (submod "." drop-on-message)) + +(module drop-bad racket + (require 2htdp/universe 2htdp/image) + + (define *world* #false) + + (define (u) + (universe '() + (on-new (lambda (u w) (make-bundle (cons w u) '() '()))) + (on-msg (lambda (u w m) + ;; set *world* to the first world that comes around, reuse + (unless *world* (set! *world* w)) + (make-bundle u '() (list *world*)))))) + + (define (w n) + (big-bang 3 + [to-draw (lambda (w) (overlay (text (number->string w) 22 'black) (circle 100 'solid 'red)))] + [on-tick (lambda (w) (if (= w 1) (make-package 0 n) (- w 1)))] + [register LOCALHOST] + [name n])) + + (launch-many-worlds (u) (w "one") (w "two") (w "three"))) + +; (require (submod "." drop-bad)) \ No newline at end of file