considering continuations

3 files changed, 68 insertions, 12 deletions

diff --git a/README.md b/README.md
index 415f16b..dfe3187 100644
--- a/README.md
+++ b/README.md
@@ -16,6 +16,11 @@ that can do cycle detection.
 Cuprate supports TR7, CHICKEN-5, Foment, Chibi, SKINT, Gauche, and
 Sagittarius. STKLOS, Mosh, Chez, Guile, Racket, and Loko support soon.
 
+TODO: Allow for (conceptually) delimited continuations to be captured and
+reinstated even if they are made in a different test group / assertion.
+The continuation's test-info will be the test-info at the time of capture.
+Returning through the same group/assertion twice will raise an exception.
+
 ## API
 
 ### `test-info` procedures
@@ -187,6 +192,39 @@ Evaluates `body ...` in a test. This test will set
 Execute all tests in `body ...`, reporting a success if they fail and
 reporting a failure if the succeed.
 
+## Continuations
+
+Cuprate will raise an exception if
+
+1. A test/group is exited more than once, or
+2. A test/group has a test/group run in it after it has run.
+
+This means that continuations captured in one invocation of a test/group
+and used outside of it cannot have internal assertions inside of it,
+and cannot return through the test/group again.
+
+Exiting a test/group more than once is certainly an error and I cannot
+imagine a scenario where that is desired.
+
+The second scenario deserves more justification. One could create some
+coroutines, run asserts on them, and return them through a group to test
+more, with internal tests in them. However, because the test object is
+a parameter, the continuations will mutate the test-info object at the
+point of continuation capture. If the entire stack of test-info objects
+before the current one is stored in the object, then it would be possible
+to keep the test numbering and other information up to date. But the
+parameterized procedures are then unchangable.
+
+The other issue is that requires exposing a lot of mutation in the
+test-info objects. This basically re-creates the design of SRFI-64.
+Another issue is that there is no way to know how many tests run in a
+group until the very end of the testing.
+
+If one wants to write coroutines with internal assertions, then there
+needs to be a way to splice the current test-info as a parameterized
+value into the continuation of the coroutine. But since coroutines are
+like threads, it would be better to just not have internal assertions.
+
 ## Porting Guide
 
 This library requires `make-parameter` and `parameterize` to work like
diff --git a/lib/cuprate-impl.scm b/lib/cuprate-impl.scm
index 94f1902..dec3959 100644
--- a/lib/cuprate-impl.scm
+++ b/lib/cuprate-impl.scm
@@ -2,7 +2,14 @@
 ;;; Manipulating the test info
 ;;; ;;;;;;;;;;;;;;;;;;;
 
+;;; TODO: test the fact that tests cannot be exited twice, or that test
+;;; infos cannot be modified once exited.
+
 (define (modify-test-info! proc)
+  (when (test-info-exited? (test-info))
+    (assertion-violation 'modify-test-info!
+                         "returned test info is immutable"
+                         (test-info)))
   (set-test-info! (test-info) (inspect-test-info proc)))
 
 (define (inspect-test-info proc)
@@ -82,8 +89,17 @@
     (parameterize ((test-info (test-info-dict)))
       ((test-ref setup!) name)
       ((body))
+      (when (test-info-exited? (test-info))
+        (assertion-violation name
+                             "exit from the same test-info twice"
+                             (test-info)))
+      (set-test-info-exited! (test-info) #t)
       ((test-ref cleanup!) name)
       (test-info-dict)))
+  (when (test-info-exited? (test-info))
+    (assertion-violation name
+                         "attempting to test in the same test-info"
+                         (test-info)))
   (if ((test-ref skip?) name)
       ((test-ref when-skipped) name)
       ((test-ref after) (exec))))
@@ -278,15 +294,16 @@
      (name-stack . ())
      (never-print-dto . ,default-test-dto)
      (pretty-print . ,pretty-print)
-     (never-print . ,(map (lambda (x) (cons x x))
-                          '(skip-test? when-test-skipped before-test! setup-test!
-                                       cleanup-test! after-test report-test
-                                       on-exception-in-test
-                                       skip-group? when-group-skipped before-group!
-                                       setup-group! cleanup-group! after-group
-                                       report-group on-exception-in-group
-                                       never-print name rewriters
-                                       never-print-dto pretty-print))))))
+     (never-print . ,(alist->default-dictionary
+                      (map (lambda (x) (cons x x))
+                           '(skip-test? when-test-skipped before-test! setup-test!
+                                        cleanup-test! after-test report-test
+                                        on-exception-in-test
+                                        skip-group? when-group-skipped before-group!
+                                        setup-group! cleanup-group! after-group
+                                        report-group on-exception-in-group
+                                        never-print name rewriters
+                                        never-print-dto pretty-print)))))))
 
 (define test-dto (make-parameter default-test-dto
                                  (lambda (x)
@@ -299,7 +316,7 @@
                                   (lambda (x)
                                     (if (test-info? x)
                                         x
-                                        (wrap-test-info x)))))
+                                        (wrap-test-info x #f)))))
 (define (test-info-dict) (unwrap-test-info (test-info)))
 
 ;;; ;;;;;;;;;;;;
diff --git a/lib/cuprate.sld b/lib/cuprate.sld
index 91df5ff..a23f55a 100644
--- a/lib/cuprate.sld
+++ b/lib/cuprate.sld
@@ -32,9 +32,10 @@
    pretty-print)
   (begin
     (define-record-type <test-info>
-      (wrap-test-info dict)
+      (wrap-test-info dict exited?)
       test-info?
-      (dict unwrap-test-info set-test-info!))
+      (dict unwrap-test-info set-test-info!)
+      (exited? test-info-exited? set-test-info-exited!))
     (define assertion-violation error))
   (cond-expand
     ((or foment chicken-5) (include "cuprate.simple-define-test-application.scm"))