From b6f6e4e7c4a6bde06bb6dec19a259e4a18090463 Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Wed, 27 May 2020 23:48:22 +0200 Subject: [PATCH] rs/test: Use test-case and define instead of let. --- rs.rkt | 161 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 83 insertions(+), 78 deletions(-) diff --git a/rs.rkt b/rs.rkt index 14dd037..342e1b4 100644 --- a/rs.rkt +++ b/rs.rkt @@ -87,18 +87,18 @@ (module+ test (test-case "Basic definitions" - (let* ([r1 (reaction (set 'x) (set 'y) (set 'z))] - [r2 (reaction (set 'x) (set) (set 'y))] - [rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))] - [s1 (set 'x 'z)] - [s2 (set 'x 'y)]) - (check-true (enabled? r1 s1)) - (check-false (enabled? r1 s2)) - (check-equal? (list-enabled rs s1) '(a b)) - (check-equal? (list-enabled rs s2) '(b)) - (check-equal? (union-products rs '(a b)) (set 'y 'z)) - (check-equal? (apply-rs rs s1) (set 'y 'z)) - (check-equal? (apply-rs rs s2) (set 'y))))) + (define r1 (reaction (set 'x) (set 'y) (set 'z))) + (define r2 (reaction (set 'x) (set) (set 'y))) + (define rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))) + (define s1 (set 'x 'z)) + (define s2 (set 'x 'y)) + (check-true (enabled? r1 s1)) + (check-false (enabled? r1 s2)) + (check-equal? (list-enabled rs s1) '(a b)) + (check-equal? (list-enabled rs s2) '(b)) + (check-equal? (union-products rs '(a b)) (set 'y 'z)) + (check-equal? (apply-rs rs s1) (set 'y 'z)) + (check-equal? (apply-rs rs s2) (set 'y)))) ;;; ==================== @@ -122,28 +122,31 @@ (values a (str-triple->reaction triple)))) (module+ test - (check-equal? - (ht-str-triples->rs #hash((a . ("x t" "y" "z")))) - (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z))))))) + (test-case "ht-str-triples->rs" + (check-equal? + (ht-str-triples->rs #hash((a . ("x t" "y" "z")))) + (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z)))))))) ;;; Reads a reaction system from an Org-mode style string. (define read-org-rs (compose ht-str-triples->rs read-org-variable-mapping)) (module+ test - (check-equal? (read-org-rs "((\"a\" \"x t\" \"y\" \"z\") (\"b\" \"x\" \"q\" \"z\"))") - (hash - 'a - (reaction (set 'x 't) (set 'y) (set 'z)) - 'b - (reaction (set 'x) (set 'q) (set 'z))))) + (test-case "read-org-rs" + (check-equal? (read-org-rs "((\"a\" \"x t\" \"y\" \"z\") (\"b\" \"x\" \"q\" \"z\"))") + (hash + 'a + (reaction (set 'x 't) (set 'y) (set 'z)) + 'b + (reaction (set 'x) (set 'q) (set 'z)))))) ;;; Reads a context sequence from an Org sexp corresponding to a list. (define (read-context-sequence str) (map (compose list->set read-symbol-list) (flatten (string->any str)))) (module+ test - (check-equal? (read-context-sequence "((\"x y\") (\"z\") (\"\") (\"t\"))") - (list (set 'x 'y) (set 'z) (set) (set 't)))) + (test-case "read-context-sequence" + (check-equal? (read-context-sequence "((\"x y\") (\"z\") (\"\") (\"t\"))") + (list (set 'x 'y) (set 'z) (set) (set 't))))) ;;; Converts a reaction to a triple of strings. (define/match (reaction->str-triple r) @@ -158,9 +161,10 @@ (values a (reaction->str-triple r)))) (module+ test - (check-equal? - (rs->ht-str-triples (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z)))))) - #hash((a . ("t x" "y" "z"))))) + (test-case "rs->ht-str-triples" + (check-equal? + (rs->ht-str-triples (make-immutable-hash (list (cons 'a (reaction (set 'x 't) (set 'y) (set 'z)))))) + #hash((a . ("t x" "y" "z")))))) ;;; ============================ @@ -242,59 +246,60 @@ (module+ test (test-case "Dynamics of reaction systems" - (let* ([r1 (reaction (set 'x) (set 'y) (set 'z))] - [r2 (reaction (set 'x) (set) (set 'y))] - [rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))] - [dyn (dynamics rs)] - [state1 (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))] - [sgr (dds-build-state-graph-annotated dyn (set state1))] - [ip (build-interactive-process-graph rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))]) - (check-equal? (dds-step-one-annotated dyn state1) - (set (cons - (set 'a 'b) - (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z)))))) - (check-equal? (dds-step-one dyn state1) - (set (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))))) + (define r1 (reaction (set 'x) (set 'y) (set 'z))) + (define r2 (reaction (set 'x) (set) (set 'y))) + (define rs (make-immutable-hash (list (cons 'a r1) (cons 'b r2)))) + (define dyn (dynamics rs)) + (define state1 (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))) + (define sgr (dds-build-state-graph-annotated dyn (set state1))) + (define ip (build-interactive-process-graph rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z)))) - (check-true (has-vertex? sgr (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))))) - (check-true (has-vertex? sgr (state (set) (list (set 'z) (set) (set 'z))))) - (check-true (has-vertex? sgr (state (set) (list (set) (set 'z))))) - (check-true (has-vertex? sgr (state (set) (list (set 'z))))) - (check-true (has-vertex? sgr (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z))))) - (check-true (has-vertex? sgr (state (set) '()))) + (check-equal? (dds-step-one-annotated dyn state1) + (set (cons + (set 'a 'b) + (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z)))))) + (check-equal? (dds-step-one dyn state1) + (set (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))))) - (check-equal? (edge-weight sgr - (state (set) '()) - (state (set) '())) - (set (set))) - (check-equal? (edge-weight sgr - (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))) - (state (set) (list (set 'z) (set) (set 'z)))) - (set (set))) - (check-equal? (edge-weight sgr - (state (set) (list (set 'z) (set) (set 'z))) - (state (set) (list (set) (set 'z)))) - (set (set))) - (check-equal? (edge-weight sgr - (state (set) (list (set) (set 'z))) - (state (set) (list (set 'z)))) - (set (set))) - (check-equal? (edge-weight sgr - (state (set) (list (set 'z))) - (state (set) '())) - (set (set))) - (check-equal? (edge-weight sgr - (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z))) - (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z)))) - (set (set 'a 'b))) + (check-true (has-vertex? sgr (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))))) + (check-true (has-vertex? sgr (state (set) (list (set 'z) (set) (set 'z))))) + (check-true (has-vertex? sgr (state (set) (list (set) (set 'z))))) + (check-true (has-vertex? sgr (state (set) (list (set 'z))))) + (check-true (has-vertex? sgr (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z))))) + (check-true (has-vertex? sgr (state (set) '()))) - (check-equal? sgr ip) + (check-equal? (edge-weight sgr + (state (set) '()) + (state (set) '())) + (set (set))) + (check-equal? (edge-weight sgr + (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z))) + (state (set) (list (set 'z) (set) (set 'z)))) + (set (set))) + (check-equal? (edge-weight sgr + (state (set) (list (set 'z) (set) (set 'z))) + (state (set) (list (set) (set 'z)))) + (set (set))) + (check-equal? (edge-weight sgr + (state (set) (list (set) (set 'z))) + (state (set) (list (set 'z)))) + (set (set))) + (check-equal? (edge-weight sgr + (state (set) (list (set 'z))) + (state (set) '())) + (set (set))) + (check-equal? (edge-weight sgr + (state (set) (list (set 'x) (set 'y) (set 'z) (set) (set 'z))) + (state (set 'y 'z) (list (set 'y) (set 'z) (set) (set 'z)))) + (set (set 'a 'b))) - (check-equal? (build-interactive-process rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z))) - (list - (list (set 'x) (set)) - (list (set 'y) (set 'y 'z)) - (list (set 'z) (set)) - (list (set) (set)) - (list (set 'z) (set)) - (list (set) (set))))))) + (check-equal? sgr ip) + + (check-equal? (build-interactive-process rs (list (set 'x) (set 'y) (set 'z) (set) (set 'z))) + (list + (list (set 'x) (set)) + (list (set 'y) (set 'y 'z)) + (list (set 'z) (set)) + (list (set) (set)) + (list (set 'z) (set)) + (list (set) (set))))))