110 lines
4.6 KiB
Racket
110 lines
4.6 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/set)
|
|
(require "../test-implementation.rkt")
|
|
(require "../main.rkt")
|
|
(require "../pattern.rkt")
|
|
(require "../skeleton.rkt")
|
|
|
|
(test-case
|
|
[(message-struct set-box (new-value))
|
|
(assertion-struct box-state (value))
|
|
|
|
(spawn!
|
|
(current-actor)
|
|
'box
|
|
(lambda ()
|
|
(define current-value (field-handle 'current-value
|
|
(generate-id! (actor-dataspace (current-actor)))
|
|
(current-actor)
|
|
0))
|
|
(add-endpoint! (current-facet)
|
|
'stop-when-ten
|
|
#t
|
|
(lambda ()
|
|
(when (= (current-value) 3)
|
|
(stop-facet! (current-facet)
|
|
(lambda ()
|
|
(printf "box: terminating\n"))))
|
|
(values (void) #f)))
|
|
(add-endpoint! (current-facet)
|
|
'assert-box-state
|
|
#t
|
|
(lambda () (values (box-state (current-value)) #f)))
|
|
(add-endpoint!
|
|
(current-facet)
|
|
'on-message-set-box
|
|
#t
|
|
(lambda ()
|
|
(values (observe (set-box (capture (discard))))
|
|
(skeleton-interest (list struct:set-box #f)
|
|
'()
|
|
'()
|
|
'((0))
|
|
(capture-facet-context
|
|
(lambda (op new-value)
|
|
(when (eq? '! op)
|
|
(schedule-script!
|
|
(current-actor)
|
|
(lambda ()
|
|
(printf "box: taking on new-value ~v\n"
|
|
new-value)
|
|
(current-value new-value))))))
|
|
#f)))))
|
|
(set))
|
|
|
|
(spawn!
|
|
(current-actor)
|
|
'client
|
|
(lambda ()
|
|
(add-endpoint!
|
|
(current-facet)
|
|
'stop-when-retracted-observe-set-box
|
|
#t
|
|
(lambda ()
|
|
(values (observe (observe (set-box (discard))))
|
|
(skeleton-interest (list struct:observe (list struct:set-box #f))
|
|
'()
|
|
'()
|
|
'()
|
|
(capture-facet-context
|
|
(lambda (op)
|
|
(when (eq? '- op)
|
|
(stop-facet!
|
|
(current-facet)
|
|
(lambda ()
|
|
(printf "client: box has gone\n"))))))
|
|
#f))))
|
|
(add-endpoint!
|
|
(current-facet)
|
|
'on-asserted-box-state
|
|
#t
|
|
(lambda ()
|
|
(values (observe (box-state (capture (discard))))
|
|
(skeleton-interest (list struct:box-state #f)
|
|
'()
|
|
'()
|
|
'((0))
|
|
(capture-facet-context
|
|
(lambda (op v)
|
|
(when (eq? '+ op)
|
|
(schedule-script!
|
|
(current-actor)
|
|
(lambda ()
|
|
(printf
|
|
"client: learned that box's value is now ~v\n"
|
|
v)
|
|
(enqueue-send! (current-actor)
|
|
(set-box (+ v 1))))))))
|
|
#f)))))
|
|
(set))]
|
|
no-crashes
|
|
(expected-output (list "client: learned that box's value is now 0"
|
|
"box: taking on new-value 1"
|
|
"client: learned that box's value is now 1"
|
|
"box: taking on new-value 2"
|
|
"client: learned that box's value is now 2"
|
|
"box: taking on new-value 3"
|
|
"box: terminating"
|
|
"client: box has gone")))
|