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:
parent
2b3db0acb7
commit
268544d565
|
@ -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)
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -3,18 +3,23 @@
|
|||
(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")))
|
||||
|
|
Loading…
Reference in New Issue
Block a user