Extract raw dataspace test to separate file
This commit is contained in:
parent
2652147141
commit
f45323a097
|
@ -59,8 +59,6 @@
|
||||||
(require racket/set)
|
(require racket/set)
|
||||||
(require (only-in racket/exn exn->string))
|
(require (only-in racket/exn exn->string))
|
||||||
|
|
||||||
(module+ test (require rackunit))
|
|
||||||
|
|
||||||
(require "skeleton.rkt")
|
(require "skeleton.rkt")
|
||||||
(require "pattern.rkt")
|
(require "pattern.rkt")
|
||||||
(require "bag.rkt")
|
(require "bag.rkt")
|
||||||
|
@ -604,102 +602,3 @@
|
||||||
(lambda () (apply raw-resume-parent results)))))
|
(lambda () (apply raw-resume-parent results)))))
|
||||||
(proc resume-parent))))
|
(proc resume-parent))))
|
||||||
prompt-tag))
|
prompt-tag))
|
||||||
|
|
||||||
;;---------------------------------------------------------------------------
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(message-struct set-box (new-value))
|
|
||||||
(assertion-struct box-state (value))
|
|
||||||
|
|
||||||
(define ds
|
|
||||||
(make-dataspace
|
|
||||||
(lambda ()
|
|
||||||
(schedule-script!
|
|
||||||
(current-actor)
|
|
||||||
(lambda ()
|
|
||||||
(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
|
|
||||||
(lambda ()
|
|
||||||
(when (= (current-value) 10)
|
|
||||||
(stop-facet! (current-facet)
|
|
||||||
(lambda ()
|
|
||||||
(log-info "box: terminating"))))
|
|
||||||
(void))
|
|
||||||
#f)
|
|
||||||
(add-endpoint! (current-facet)
|
|
||||||
'assert-box-state
|
|
||||||
(lambda () (box-state (current-value)))
|
|
||||||
#f)
|
|
||||||
(add-endpoint! (current-facet)
|
|
||||||
'on-message-set-box
|
|
||||||
(lambda () (observe (set-box (capture (discard)))))
|
|
||||||
(skeleton-interest (list struct:set-box #f)
|
|
||||||
'()
|
|
||||||
'()
|
|
||||||
'((0 0))
|
|
||||||
(capture-facet-context
|
|
||||||
(lambda (op new-value)
|
|
||||||
(when (eq? '! op)
|
|
||||||
(schedule-script!
|
|
||||||
(current-actor)
|
|
||||||
(lambda ()
|
|
||||||
(log-info "box: taking on new-value ~v" new-value)
|
|
||||||
(current-value new-value))))))
|
|
||||||
#f)))
|
|
||||||
(set))
|
|
||||||
(spawn!
|
|
||||||
(current-actor)
|
|
||||||
'client
|
|
||||||
(lambda ()
|
|
||||||
(add-endpoint! (current-facet)
|
|
||||||
'stop-when-retracted-observe-set-box
|
|
||||||
(lambda () (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 ()
|
|
||||||
(log-info "client: box has gone"))))))
|
|
||||||
#f))
|
|
||||||
(add-endpoint! (current-facet)
|
|
||||||
'on-asserted-box-state
|
|
||||||
(lambda () (observe (box-state (capture (discard)))))
|
|
||||||
(skeleton-interest (list struct:box-state #f)
|
|
||||||
'()
|
|
||||||
'()
|
|
||||||
'((0 0))
|
|
||||||
(capture-facet-context
|
|
||||||
(lambda (op v)
|
|
||||||
(when (eq? '+ op)
|
|
||||||
(schedule-script!
|
|
||||||
(current-actor)
|
|
||||||
(lambda ()
|
|
||||||
(log-info "client: learned that box's value is now ~v" v)
|
|
||||||
(enqueue-send! (current-actor)
|
|
||||||
(set-box (+ v 1))))))))
|
|
||||||
#f)))
|
|
||||||
(set)))))))
|
|
||||||
|
|
||||||
(require racket/pretty)
|
|
||||||
;; (pretty-print ds)
|
|
||||||
(#;time values
|
|
||||||
(let loop ((i 0))
|
|
||||||
;; (printf "--- i = ~v\n" i)
|
|
||||||
(when (run-scripts! ds)
|
|
||||||
;; (pretty-print ds)
|
|
||||||
(loop (+ i 1)))))
|
|
||||||
;; (pretty-print ds)
|
|
||||||
)
|
|
||||||
|
|
|
@ -0,0 +1,99 @@
|
||||||
|
#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
|
||||||
|
(lambda ()
|
||||||
|
(when (= (current-value) 3)
|
||||||
|
(stop-facet! (current-facet)
|
||||||
|
(lambda ()
|
||||||
|
(printf "box: terminating\n"))))
|
||||||
|
(void))
|
||||||
|
#f)
|
||||||
|
(add-endpoint! (current-facet)
|
||||||
|
'assert-box-state
|
||||||
|
(lambda () (box-state (current-value)))
|
||||||
|
#f)
|
||||||
|
(add-endpoint! (current-facet)
|
||||||
|
'on-message-set-box
|
||||||
|
(lambda () (observe (set-box (capture (discard)))))
|
||||||
|
(skeleton-interest (list struct:set-box #f)
|
||||||
|
'()
|
||||||
|
'()
|
||||||
|
'((0 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
|
||||||
|
(lambda () (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
|
||||||
|
(lambda () (observe (box-state (capture (discard)))))
|
||||||
|
(skeleton-interest (list struct:box-state #f)
|
||||||
|
'()
|
||||||
|
'()
|
||||||
|
'((0 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 "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"))
|
Loading…
Reference in New Issue