2htdp/universe tests: use distinct port numbers

Using distinct port numbers allows the tests to run concurrently.
Using locally distnct port numbers is not a general solution,
of course, but it should work well enough for running these
tests with `raco test --drdr`.
This commit is contained in:
Matthew Flatt 2014-06-03 11:19:02 +01:00
parent 2b3db0acb7
commit 268544d565
6 changed files with 42 additions and 11 deletions

View File

@ -11,6 +11,9 @@
(define c (make-custodian))
;; Distinct from other tests:
(define PORT-NO 9006)
(define-values (_ n)
(parameterize ((current-custodian c))
(launch-many-worlds
@ -19,12 +22,14 @@
(on-tick sub1)
(to-draw (lambda (w) (empty-scene 200 200)))
(name NAME)
(register LOCALHOST))
(register LOCALHOST)
(port PORT-NO))
;; --- universe:
(universe #f
(on-new (lambda (u w) (make-bundle (iworld-name w) '() '())))
(on-msg (lambda (u w m) (make-bundle u '() '())))
(on-tick (lambda (u) (make-bundle u '() '())) 1 1)))))
(on-tick (lambda (u) (make-bundle u '() '())) 1 1)
(port PORT-NO)))))
(check-equal? n NAME)

View File

@ -5,4 +5,6 @@
(universe 0
(on-tick (lambda (w) (make-bundle (add1 w) '() '())) 1/28 3)
(on-msg (lambda (w sender msg) (make-bundle w '() '())))
(on-new cons))
(on-new cons)
;; Distinct from other tests:
(port 9000))

View File

@ -5,4 +5,6 @@
(uni:universe 0
(uni:on-new cons)
(uni:on-msg list)
(uni:on-tick add1)))
(uni:on-tick add1)
;; Distinct from other tests:
(uni:port 9004)))

View File

@ -3,8 +3,13 @@
(module shared racket/base
(require 2htdp/universe 2htdp/image)
;; Distinct from other tests:
(define PORT-NO 9003)
(struct s (t) #:prefab)
(provide s s-t (all-from-out 2htdp/universe 2htdp/image)))
(provide s s-t (all-from-out 2htdp/universe 2htdp/image)
PORT-NO))
(module client racket
(require (submod ".." shared))
@ -15,6 +20,7 @@
(big-bang #true
(to-draw (lambda (w) (text (if w "hello world" "good bye") 22 c)))
(register LOCALHOST)
(port PORT-NO)
#;
(stop-when (lambda (w) (> count 3)))
(on-receive
@ -40,7 +46,8 @@
(lambda (state iw msg)
;; display the received prefabbed struct's content
(displayln (s-t msg))
(make-bundle state '() '())))))
(make-bundle state '() '())))
(port PORT-NO)))
(provide server))

View File

@ -4,6 +4,9 @@
(require 2htdp/universe)
(require 2htdp/image)
;; Distinct from other tests:
(define PORT-NO 9002)
;; Nat Nat ->* World1 World2 [Listof IWorld]
;; launch a sending world, a receiving world, and a connecting universe
(define (main rate limit)
@ -30,7 +33,8 @@
(universe '()
(on-tick (lambda (s) (make-bundle s '() '())) 1 10)
(on-new accept-another-world)
(on-msg forward-message)))))
(on-msg forward-message)
(port PORT-NO)))))
;; World1 = Number
@ -44,7 +48,8 @@
(to-draw (draw 'red))
(on-receive reset)
(stop-when zero?)
(register LOCALHOST))))
(register LOCALHOST)
(port PORT-NO))))
;; World2 = Number

View File

@ -2,19 +2,24 @@
(module drop-on-message racket
(require 2htdp/universe 2htdp/image)
;; Distinct from other tests:
(define PORT-NO 9001)
(define (u)
(universe 0
(on-new (lambda (u w) (make-bundle (+ u 1) '() '())))
(on-tick (lambda (w) (make-bundle w '() '())) 1 3)
(on-msg (lambda (u w m) (make-bundle (- u 1) '() (list w))))
(state #t)))
(state #t)
(port PORT-NO)))
(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]
[port PORT-NO]
[name n]))
(launch-many-worlds (u) (w "one") (w "two")))
@ -24,6 +29,9 @@
(module drop-bad racket
(require 2htdp/universe 2htdp/image)
;; Distinct from other tests:
(define PORT-NO 9005)
(define *world* #false)
(define (u)
@ -33,13 +41,15 @@
(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*))))))
(make-bundle u '() (list *world*))))
(port PORT-NO)))
(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]
[port PORT-NO]
[name n]))
(launch-many-worlds (u) (w "one") (w "two") (w "three")))