From f45323a0970cf2587b9a36bbf36d3065ff828e8f Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sun, 29 Apr 2018 16:08:52 +0100 Subject: [PATCH] Extract raw dataspace test to separate file --- syndicate/dataspace.rkt | 101 ------------------------------- syndicate/test/raw-dataspace.rkt | 99 ++++++++++++++++++++++++++++++ 2 files changed, 99 insertions(+), 101 deletions(-) create mode 100644 syndicate/test/raw-dataspace.rkt diff --git a/syndicate/dataspace.rkt b/syndicate/dataspace.rkt index 3fff4dd..27667cf 100644 --- a/syndicate/dataspace.rkt +++ b/syndicate/dataspace.rkt @@ -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) - ) diff --git a/syndicate/test/raw-dataspace.rkt b/syndicate/test/raw-dataspace.rkt new file mode 100644 index 0000000..b62610d --- /dev/null +++ b/syndicate/test/raw-dataspace.rkt @@ -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"))