syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Extract raw dataspace test to separate file

This commit is contained in:
Tony Garnock-Jones 2018-04-29 16:08:52 +01:00
parent 2652147141
commit f45323a097
2 changed files with 99 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
syndicate/dataspace.rkt
View File

@ -59,8 +59,6 @@
(require racket/set)
(require (only-in racket/exn exn->string))
(module+ test (require rackunit))
(require "skeleton.rkt")
(require "pattern.rkt")
(require "bag.rkt")
@ -604,102 +602,3 @@
(lambda () (apply raw-resume-parent results)))))
(proc resume-parent))))
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)
)

99
syndicate/test/raw-dataspace.rkt Normal file
View File

@ -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"))