add conspire, with most meta-tests passed

10 files changed, 1164 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..111df7d
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,9 @@
+tests/*.log
+*.import.scm
+*.a
+*.o
+*.so
+*.build.sh
+*.install.sh
+*.link
+*.tar.gz
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..cb60c8c
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,20 @@
+Copyright © 2025 Peter McGoron
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+“Software”), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
+NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..9d00465
--- /dev/null
+++ b/README.md
@@ -0,0 +1,187 @@
+# Conspire
+
+Conspire is an experiment in providing a portable R6RS/R7RS testing
+library. It uses purely functional data structures in a mutable parameter
+object, allowing for procedural programming inside of a dynamic extent
+to not affect the rest of the test system.
+
+## API
+
+### `test-info` procedures
+
+    `test-info`
+
+What SRFI-64 would call the "test runner" is in Conspire the `test-info`,
+which contains a pure SRFI-225 dictionary with an associated DTO. The
+dictionary must map at least symbols to values (including procedures).
+
+Whenever a test group or a test is entered, a new dynamic extent is
+entered with a new test-info object. Destructive updates to the new test
+info are not reflected in the test info of the call.
+
+The `test-info` is a parameter and can be modified with the `parameterize`
+form. The inputs to `test-info` must be one of:
+
+* `copy`: Return an unchanged copy of the `test-info`
+* `replace dict [dto]`: In the new dynamic extent, the dictionary is
+  replaced with `dict`, optionally with new dto `dto`.
+
+    test-set!
+    test-update!
+    test-update/default!
+    test-delete-all!
+    test-contains?
+    test-ref
+    test-ref/default
+    test-update/default
+
+These procedures are the same as their SRFI-225 equivalents, except
+that the DTO and dictionary arguments are not needed, and that the
+mutating procedures return unspecified values. For instance,
+
+    (test-set! key value)
+
+is equivalent to `(dict-set! dto dict key value)`.
+
+    (modify-test-info! proc)
+
+Evaluates `(proc dto dict)`, where `dto` is the current `test-info` DTO
+and `dict` is the current `test-info` dict. The procedure must return
+a dict satisfying the same DTO. This dictionary is set as the current
+`test-info` dictionary within the dynamic extent.
+
+    (inspect-test-info proc)
+
+Evaluates `(proc dto dict)`, where `dto` is the current `test-info` DTO
+and `dict` is the current `test-info` dict, and returns the result.
+
+### `test-info` Standard Procedure Keys
+
+    before-test (default-before-test name)
+
+A procedure with one argument (the name of the test).
+Called in the dynamic extent of the caller of the test. If it returns
+false, then the test is skipped.
+
+    test-setup (test-setup)
+
+A procedure of zero arguments. Called in the dynamic extent of a
+test. Used to set up parts of a test.
+
+    after-test (default-after-test dto dict)
+
+A procedure of two arguments (the DTO and dictionary of the test). Called
+in the dynamic extent of the caller. Used to report information about
+the test, and to merge desired information into the calling test info.
+
+    report-test (default-report-test dto dict)
+
+A procedure of two arguments (the DTO and dictionary of the test). Used by
+`default-after-test` to report the result of the test to the user.
+
+    group-begin (default-group-begin name)
+
+A procedure of one argument (the name of the group). Called in the dynamic
+extent of the group. Used to set up common information for a whole group.
+
+    group-end (default-group-end dto dict)
+
+A procedure of two arguments (the DTO and the dictionary of the
+test). Called in the dynamic extent containing the group. Used to report
+information about the group and merge it with the containing test info.
+
+### `test-info` Standard Keys
+
+* `success?`: Truthy if the test passed.
+* `exception`: The caught exception, if any.
+* `tests`: Number of run tests.
+* `passed`: Number of passed tests.
+* `failed`: Number of failed tests.
+* `skipped`: Number of skipped tests.
+* `verbose?`: Used by the default test setups. If false, only failures are
+  printed. Otherwise all test case information is printed.
+
+### Test Procedures and Forms
+
+If `test-name` is `#f`, then the test is not given a name. Every procedure
+here is implemented using `call-as-test`.
+
+    (call-as-test test-name thunk)
+
+Call `thunk` with the test name `test-name`.
+
+First executes the procedure stored in `before-test` in the `test-info` of
+the caller. If that returns non-false, then it creates a new `test-info`
+inheriting from the `test-info` of the caller, and runs the procedure
+stored in `test-setup` (in the new `test-info`). Then `thunk` will
+be executed in this dynamic extent. If `thunk` throws an exception,
+it will be caught. Afterwards, the procedure stored in `after-test`
+will be run with the `test-info` of the caller.
+
+The test will set
+
+* `success?`: Will be set to `#f` if an exception was caught.
+* `exception`: Only set if an exception was caught. The value is the
+  caught exception.
+
+    (test-application test-name (name expr) ...)
+
+The `name` must be symbols that are mutually not `bound-identifier=?`.
+Runs a test with `test-name` that evaluates `(expr ...)`.
+
+The test will set (in addition to `call-as-test`):
+
+* `name`: To be the passed `expr` quoted.
+* `application`: A list `(expr ...)`, where each is evaluated.
+* `success?`: If `(expr ...)` evaluates to not false.
+
+    (with-test-assert test-name body ...)
+
+Execute `body` in a test with `test-name`.
+
+The test will set (in addition to `call-as-test`):
+
+* `success?`: The returned value of `body` (if an exception is not caught).
+
+    (test-eq name %expected %actual)
+    (test-eqv name %expected %actual)
+    (test-equal name %expected %actual)
+
+Convienence wrappers for
+
+    (test-application test-name ((procedure <procedure>)
+                                 (expected %expected)
+                                 (actual %actual)))
+
+    (test-approximate X Y eps)
+
+Tests that
+
+    |X - Y| <= eps
+
+The test will set (in addition to `call-as-test`):
+
+* `procedure`: to be `%test-approximate` (this is an implementation detail).
+* `expected`: to be `X`, quoted.
+* `actual`: to be `Y`, quoted.
+* `error`: to be `eps`, quoted.
+* `application`: The `car` is `%test-approximate`, and the `cdr` is
+  `expected`, `actual`, and `error,` evaluated.
+
+    (with-test-error name error-predicate body ...)
+
+Evaluates `body ...` in a test. This test will set
+
+* `success?`: False if evaluation does not throw an exception. Otherwise
+  the return value of `error-predicate` on the thrown exception.
+
+## Porting Guide
+
+This library requires `make-parameter` and `parameterize` to work like
+in R7RS. Most R6RS implementations should support dynamic parameters out
+of the box.
+
+Multi-threaded implementations must export an SRFI-18 compatible
+interface for mutexes. Single threaded implementations can use the
+`compat.single-threaded.sld` (`compat.single-threaded.sls` for R6RS)
+implementations.
diff --git a/conspire.egg b/conspire.egg
new file mode 100644
index 0000000..fde76be
--- /dev/null
+++ b/conspire.egg
@@ -0,0 +1,12 @@
+((author "Peter McGoron")
+ (version "0.1.0")
+ (synopsis "A R6RS/R7RS testing suite")
+ (category "test")
+ (license "MIT")
+ (dependencies "r7rs" "srfi-18" "srfi-225")
+ (test-dependencies "srfi-64")
+ (components (extension conspire
+               (source "lib/conspire.sld")
+               (source-dependencies "lib/conspire.scm"
+                                    "lib/r7rs-srfi-18.scm")
+               (csc-options "-R" "r7rs" "-X" "r7rs"))))
diff --git a/lib/conspire.scm b/lib/conspire.scm
new file mode 100644
index 0000000..bc0ad5b
--- /dev/null
+++ b/lib/conspire.scm
@@ -0,0 +1,377 @@
+#| Copyright © 2025 Peter McGoron
+ |
+ | Permission is hereby granted, free of charge, to any person obtaining
+ | a copy of this software and associated documentation files (the
+ | “Software”), to deal in the Software without restriction, including
+ | without limitation the rights to use, copy, modify, merge, publish,
+ | distribute, sublicense, and/or sell copies of the Software, and to
+ | permit persons to whom the Software is furnished to do so, subject to
+ | the following conditions:
+ |
+ | The above copyright notice and this permission notice shall be included
+ | in all copies or substantial portions of the Software.
+ |
+ | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+ | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
+ | NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+ | DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+ | OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+ | THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ |#
+
+;;; ;;;;;;;;;;;;;;;;;;;
+;;; Manipulating the test info
+;;; ;;;;;;;;;;;;;;;;;;;
+
+(define (modify-test-info! proc)
+  (let ((mutex (test-info-mutex (test-info))))
+    (dynamic-wind
+     (lambda () (mutex-lock! mutex))
+     (lambda ()
+       (set-test-info-dict! (test-info)
+                            (proc (test-info-dto (test-info))
+                                  (test-info-dict (test-info)))))
+     (lambda () (mutex-unlock! mutex)))))
+
+(define (inspect-test-info proc)
+  (let ((mutex (test-info-mutex (test-info))))
+    (dynamic-wind
+     (lambda () (mutex-lock! mutex))
+     (lambda () (proc (test-info-dto (test-info))
+                      (test-info-dict (test-info))))
+     (lambda () (mutex-unlock! mutex)))))
+
+(define-syntax define-destructive-test-info-procedure
+  (syntax-rules ()
+    ((_ (name args ...) proc)
+     (define (name args ...)
+       (modify-test-info! (lambda (dto dictionary)
+                            (proc dto dictionary args ...)))))
+    ((_ (name . args) proc)
+     (define (name . other-args)
+       (modify-test-info! (lambda (dto dictionary)
+                            (apply proc dto dictionary other-args)))))))
+
+(define-syntax define-inspecting-test-info-procedure
+  (syntax-rules ()
+    ((_ (name args ...) proc)
+     (define (name args ...)
+       (inspect-test-info (lambda (dto dictionary)
+                            (proc dto dictionary args ...)))))
+    ((_ (name . args) proc)
+     (define (name . other-args)
+       (inspect-test-info (lambda (dto dictionary)
+                            (apply proc dto dictionary other-args)))))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Mutating operations on the test info
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-destructive-test-info-procedure
+    (test-set! . args) dict-set!)
+(define-destructive-test-info-procedure
+    (test-update! key updater . rest) dict-update!)
+(define-destructive-test-info-procedure
+    (test-update/default! key updater default) dict-update/default!)
+(define-destructive-test-info-procedure
+    (test-delete! . keys) dict-delete!)
+
+(define-inspecting-test-info-procedure
+    (test-contains? key) dict-contains?)
+(define-inspecting-test-info-procedure
+    (test-ref key . rest) dict-ref)
+(define-inspecting-test-info-procedure
+    (test-ref/default key default) dict-ref/default)
+(define-inspecting-test-info-procedure
+    (test-set . args) dict-set!)
+(define-inspecting-test-info-procedure
+    (test-update/default key value) dict-update/default!)
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Manipulating the parameter object
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (call-with-name name thunk)
+  (define dict
+    (inspect-test-info
+     (lambda (dto dict)
+       (set! dict (dict-set! dto dict 'name name))
+       (if name
+           (dict-update/default! dto dict
+                                 'name-stack
+                                 (lambda (pair) (cons name pair))
+                                 '())
+           dict))))
+  (parameterize ((test-info (list 'replace dict)))
+    (thunk)))
+
+(define (call-as-test name thunk)
+  (when ((test-ref 'before-test) name)
+    (let ((thunk
+           (lambda ()
+             (call/cc
+              (lambda (return)
+                (define handle
+                  (let ((on-exception (test-ref 'on-exception))
+                        (return (lambda () (return #f))))
+                    (lambda (exn) (on-exception exn return))))
+                ((test-ref 'setup-test))
+                (with-exception-handler handle thunk)))
+             (inspect-test-info values))))
+      (call-with-values (lambda () (call-with-name name thunk))
+        (test-ref 'after-test)))))
+
+;;; ;;;;;;;;;;
+;;; Default handlers
+;;; ;;;;;;;;;;
+
+(define (default-setup-test)
+  (test-delete! 'success?))
+
+(define (default-after-test previous-dto previous-test-info)
+  (test-update/default! 'tests
+                        (lambda (x) (+ x 1))
+                        0)
+  (let ((success? (dict-ref/default previous-dto
+                                    previous-test-info
+                                    'success?
+                                    #f)))
+    (test-update/default! (if success? 'passed 'failed)
+                          (lambda (x) (+ 1 x))
+                          0)
+    ((test-ref 'report-test) previous-dto previous-test-info)))
+
+(define (default-report-test previous-dto previous-test-info)
+  (let ((verbose? (test-ref/default 'verbose? #f))
+        (specifically-verbose? (dict-ref/default previous-dto
+                                                 previous-test-info
+                                                 'verbose?
+                                                 #f))
+        (success? (dict-ref/default previous-dto
+                                    previous-test-info
+                                    'success?
+                                    #f))
+        (name (cond
+                ((dict-ref previous-dto previous-test-info 'name))
+                (else ""))))
+    (cond
+      (success?
+       (when (or verbose? specifically-verbose?)
+         (display (string-append "success:           \"" name "\"\n"))))
+      (else
+       (display (string-append "FAILED:           \"" name "\"\n"))
+       (when (dict-contains? previous-dto previous-test-info 'exception)
+         (display (list 'exception (dict-ref previous-dto
+                                             previous-test-info
+                                             'exception)))
+         (newline))))
+    (values previous-dto previous-test-info)))
+
+(define (default-before-test name)
+  #t)
+
+(define (default-before-group name)
+  (if name
+      (display (string-append "entering group \"" name "\"\n"))
+      (display "entering group\n"))
+  #t)
+
+(define (default-setup-group name)
+  (test-set! 'tests 0)
+  (test-set! 'passed 0)
+  (test-set! 'failed 0)
+  (test-set! 'skipped 0))
+
+(define (default-after-group previous-dto previous-info)
+  (define (update/previous! name)
+    (test-update/default!
+     name
+     (lambda (x) (+ x (dict-ref/default previous-dto
+                                        previous-info
+                                        name
+                                        0)))
+     0))
+  (update/previous! 'tests)
+  (update/previous! 'passed)
+  (update/previous! 'failed)
+  (update/previous! 'skipped)
+  ((test-ref 'report-group) previous-dto previous-info))
+
+(define (default-report-group previous-dto previous-info)
+  (cond
+    ((dict-ref previous-dto previous-info 'name)
+     => (lambda (name)
+          (display (string-append "group \"" name "\" exited.\n"))))
+    (else (display "group exited.\n")))
+  (values previous-dto previous-info))
+
+(define (default-on-exception exn return)
+  (test-set! 'success? #f)
+  (test-set! 'exception exn)
+  (return))
+
+;;; ;;;;;;;;;;;;;;;;
+;;; test info
+;;; ;;;;;;;;;;;;;;;;
+
+(define default-test-info-dict
+  `((before-test . ,default-before-test)
+    (setup-test . ,default-setup-test)
+    (after-test . ,default-after-test)
+    (report-test . ,default-report-test)
+    (setup-group . ,default-setup-group)
+    (after-group . ,default-after-group)
+    (before-group . ,default-before-group)
+    (report-group . ,default-report-group)
+    (on-exception . ,default-on-exception)
+    (passed . 0)
+    (failed . 0)
+    (skipped . 0)
+    (tests . 0)))
+
+(define default-dto equal-alist-dto)
+
+(define test-info
+  (make-parameter
+   (list 'replace default-dto default-test-info-dict)
+   (lambda (value)
+     (cond
+       ((not (pair? value))
+        (raise-conspire-error "invalid arguments to parameterize"
+                              value))
+       ((eq? (car value) 'box)
+        (unless (null? (cdr value))
+          (raise-conspire-error "invalid arguments to copy"
+                                value))
+        (inspect-test-info make-test-info))
+       ((eq? (car value) 'replace)
+        (cond
+          ((null? (list-tail value 1))
+           (raise-conspire-error "not enough arguments to replace"
+                                 value))
+          ((null? (list-tail value 2))
+           (inspect-test-info (lambda (dto _)
+                                (make-test-info dto
+                                                (list-ref value 1)))))
+          ((null? (list-tail value 3))
+           (make-test-info (list-ref value 1) (list-ref value 2)))
+          (else (raise-conspire-error "too many arguments to replace"
+                                      value))))
+       ((eq? (car value) 'operate)
+        (call-with-values (lambda ()
+                            (inspect-test-info (list-ref value 1)))
+          make-test-info))
+       (else (raise-conspire-error "unknown command" value))))))
+
+;;; ;;;;;;;;;;;;
+;;; Wrappers and semi-compatability with SRFI-64
+;;; ;;;;;;;;;;;;
+
+(define-syntax test-application
+  (syntax-rules ()
+    ((test-application test-name (name expr) ...)
+     (call-as-test test-name (lambda ()
+                               (test-set! (quote name) (quote expr)) ...
+                               (let ((name expr) ...)
+                                 (test-set! 'application (list name ...))
+                                 (test-set! 'success? (name ...))))))))
+
+(define-syntax with-test-assert
+  (syntax-rules ()
+    ((_ name body ...)
+     (call-as-test name (lambda ()
+                          (test-set! 'success?
+                                     (let () body ...)))))))
+
+(define-syntax test-equal
+  (syntax-rules ()
+    ((_ name %expected %actual)
+     (test-application name
+                       (procedure equal?)
+                       (expected %expected)
+                       (actual %actual)))))
+
+(define-syntax test-eqv
+  (syntax-rules ()
+    ((_ name %expected %actual)
+     (test-application name
+                       (procedure eqv?)
+                       (expected %expected)
+                       (actual %actual)))))
+
+
+(define-syntax test-eq
+  (syntax-rules ()
+    ((_ name %expected %actual)
+     (test-application name
+                       (procedure eq?)
+                       (expected %expected)
+                       (actual %actual)))))
+
+(define (%test-approximate expected actual error)
+  (<= (abs (- expected actual)) error))
+
+(define-syntax test-approximate
+  (syntax-rules ()
+    ((_ name %expected %actual %error)
+     (test-application name
+                       (procedure %test-approximate)
+                       (expected %expected)
+                       (actual %actual)
+                       (error %error)))))
+
+(define (call-as-test-error name error-predicate thunk)
+  (define (outer-thunk)
+    (test-set! 'success?
+               (call/cc
+                (lambda (return)
+                  (with-exception-handler (lambda (ex)
+                                            (test-set! 'exception ex)
+                                            (return (error-predicate ex)))
+                    (lambda () (thunk) #f))))))
+  (call-as-test name outer-thunk))
+
+(define-syntax with-test-error
+  (syntax-rules ()
+    ((_ name error-predicate body ...)
+     (call-as-test-error name error-predicate
+                         (lambda () body ...)))))
+
+(define (call-as-group name thunk)
+  (when ((test-ref 'before-group) name)
+    (let ((inside (lambda ()
+                    ((test-ref 'setup-group) name)
+                    (thunk)
+                    (inspect-test-info values))))
+      (call-with-values (lambda () (call-with-name name inside))
+        (test-ref 'after-group)))))
+
+(define-syntax test-skip-all
+  (syntax-rules ()
+    ((_ body ...)
+     (parameterize ((test-info
+                     (list 'replace
+                           (test-set 'before-test
+                                     (lambda (_) #f)))))
+       body ...))))
+
+(define-syntax test-group
+  (syntax-rules ()
+    ((_ name body ...)
+     (call-as-group name (lambda () body ...)))))
+
+(define-syntax with-test-group-cleanup
+  (syntax-rules ()
+    ((_ name body ... cleanup-expr)
+     (test-group name
+       (dynamic-wind
+        (lambda () #f)
+        (lambda () body ...)
+        (lambda () cleanup-expr))))))
+
+(define (test-exit)
+  (exit (if (zero? (test-ref/default 'failed 0))
+            0
+            1)))
+
diff --git a/lib/conspire.sld b/lib/conspire.sld
new file mode 100644
index 0000000..241ad1e
--- /dev/null
+++ b/lib/conspire.sld
@@ -0,0 +1,56 @@
+#| Copyright © 2025 Peter McGoron
+ |
+ | Permission is hereby granted, free of charge, to any person obtaining
+ | a copy of this software and associated documentation files (the
+ | “Software”), to deal in the Software without restriction, including
+ | without limitation the rights to use, copy, modify, merge, publish,
+ | distribute, sublicense, and/or sell copies of the Software, and to
+ | permit persons to whom the Software is furnished to do so, subject to
+ | the following conditions:
+ |
+ | The above copyright notice and this permission notice shall be included
+ | in all copies or substantial portions of the Software.
+ |
+ | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+ | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
+ | NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+ | DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+ | OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+ | THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ |#
+
+(define-library (conspire)
+  (import (scheme base) (scheme write) (scheme process-context) (srfi 225))
+  (export test-set! test-update! test-update/default!
+          test-contains?
+          test-ref test-ref/default
+          test-set test-update/default
+          test-delete!
+          test-info
+          call-with-name call-as-test
+          default-setup-test default-after-test default-before-test
+          default-report-test default-setup-group default-after-group
+          default-before-group default-report-group default-on-exception
+          default-test-info-dict default-dto
+          modify-test-info! inspect-test-info
+          test-application with-test-assert
+          test-equal test-eqv test-eq test-approximate
+          call-as-test-error with-test-error
+          call-as-group test-group
+          with-test-group-cleanup
+          test-skip-all
+          test-exit)
+  (begin
+    (define-record-type <conspire-error>
+      (make-conspire-error message irritants)
+      conspire-error?
+      (message conspire-error-message)
+      (irritants conspire-error-irritants))
+    (define (raise-conspire-error message . irritants)
+      (raise (make-conspire-error message irritants))))
+  (cond-expand
+    (chicken (import (srfi 18))
+             (include "r7rs-srfi-18.scm"))
+    (else (include "r7rs-single-threaded.scm")))
+  (include "conspire.scm"))
\ No newline at end of file
diff --git a/lib/r7rs-single-threaded.scm b/lib/r7rs-single-threaded.scm
new file mode 100644
index 0000000..fe57187
--- /dev/null
+++ b/lib/r7rs-single-threaded.scm
@@ -0,0 +1,27 @@
+#| Copyright © 2025 Peter McGoron
+ |
+ | Permission is hereby granted, free of charge, to any person obtaining
+ | a copy of this software and associated documentation files (the
+ | “Software”), to deal in the Software without restriction, including
+ | without limitation the rights to use, copy, modify, merge, publish,
+ | distribute, sublicense, and/or sell copies of the Software, and to
+ | permit persons to whom the Software is furnished to do so, subject to
+ | the following conditions:
+ |
+ | The above copyright notice and this permission notice shall be included
+ | in all copies or substantial portions of the Software.
+ |
+ | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+ | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
+ | NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+ | DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+ | OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+ | THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ |#
+
+(define-record-type <test-info>
+  (make-test-info dto dict)
+  test-info?
+  (dto test-info-dto)
+  (dict test-info-dict set-test-info-dict!))
\ No newline at end of file
diff --git a/lib/r7rs-srfi-18.scm b/lib/r7rs-srfi-18.scm
new file mode 100644
index 0000000..59634d8
--- /dev/null
+++ b/lib/r7rs-srfi-18.scm
@@ -0,0 +1,31 @@
+#| Copyright © 2025 Peter McGoron
+ |
+ | Permission is hereby granted, free of charge, to any person obtaining
+ | a copy of this software and associated documentation files (the
+ | “Software”), to deal in the Software without restriction, including
+ | without limitation the rights to use, copy, modify, merge, publish,
+ | distribute, sublicense, and/or sell copies of the Software, and to
+ | permit persons to whom the Software is furnished to do so, subject to
+ | the following conditions:
+ |
+ | The above copyright notice and this permission notice shall be included
+ | in all copies or substantial portions of the Software.
+ |
+ | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+ | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
+ | NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+ | DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+ | OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+ | THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ |#
+
+(define-record-type <test-info>
+  (%make-test-info dto dict mutex)
+  test-info?
+  (dto test-info-dto)
+  (dict test-info-dict set-test-info-dict!)
+  (mutex test-info-mutex))
+
+(define (make-test-info dto dict)
+  (%make-test-info dto dict (make-mutex "test-info")))
\ No newline at end of file
diff --git a/tests/impl.scm b/tests/impl.scm
new file mode 100644
index 0000000..73e51b5
--- /dev/null
+++ b/tests/impl.scm
@@ -0,0 +1,416 @@
+#| Copyright © 2025 Peter McGoron
+ |
+ | Permission is hereby granted, free of charge, to any person obtaining
+ | a copy of this software and associated documentation files (the
+ | “Software”), to deal in the Software without restriction, including
+ | without limitation the rights to use, copy, modify, merge, publish,
+ | distribute, sublicense, and/or sell copies of the Software, and to
+ | permit persons to whom the Software is furnished to do so, subject to
+ | the following conditions:
+ |
+ | The above copyright notice and this permission notice shall be included
+ | in all copies or substantial portions of the Software.
+ |
+ | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+ | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
+ | NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+ | DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+ | OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+ | THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ |#
+
+;;; This is a meta-test suite for Conspire, similar to the meta-test
+;;; suite of SRFI-64.
+;;; 
+;;; This test suite is not as straightforward as a normal test suite,
+;;; since it tests the testing library itself. Hopefully, if the tests
+;;; pass, then the library works.
+
+(test-group "test-ref, test-contains? and test-ref/default"
+  (test-group "default keys"
+    (define (test-pair name key value)
+      (test-eq name key value))
+    (for-each (lambda (key value)
+                (let ((name (symbol->string key)))
+                  (with-test-assert (string-append "contains " name)
+                    (test-contains? key))
+                  (test-eq name value (test-ref key))))
+              '(setup-test after-test before-test report-test
+                           setup-group after-group before-group report-group
+                           on-exception)
+              (list default-setup-test default-after-test
+                    default-before-test default-report-test
+                    default-setup-group default-after-group
+                    default-before-group default-report-group
+                    default-on-exception)))
+  (let ((pair (cons #f #f)))
+    (test-eq "default pair" pair (test-ref/default 'nonexistent-key pair))))
+
+(test-group "test-set and test-set!"
+  (let ((pair (cons #f #f)))
+    (test-set! 'nonexistent-key pair)
+    (test-eq "set unused key" pair (test-ref 'nonexistent-key))
+    (parameterize ((test-info '(box)))
+      (test-eq "persistent across parameterization"
+               pair
+               (test-ref 'nonexistent-key))
+      (let ((pair2 (cons #f #f)))
+        (with-test-assert "made a new pair"
+          (not (eq? pair pair2)))
+        (test-set! 'nonexistent-key pair2)
+        (test-eq "set key to a new pair"
+                 pair2
+                 (test-ref 'nonexistent-key))))
+    (test-eq "outside of parameterization"
+             pair
+             (test-ref 'nonexistent-key)))
+  (parameterize ((test-info (list 'replace
+                                  (test-set 'other-key 123))))
+    (test-eqv "other key in parameterization"
+              123
+              (test-ref 'other-key)))
+  (test-eqv "does not affect outside"
+            456
+            (test-ref/default 'other-key 456))
+  (with-test-assert "deleted key"
+    (test-delete! 'nonexistent-key)
+    (not (test-contains? 'nonexistent-keys))))
+
+(test-group "call-with-name"
+  (with-test-assert "inherits test info"
+    (let ((success? #f))
+      (parameterize ((test-info (list 'replace (test-set 'inherits? #t))))
+        (call-with-name "test"
+          (lambda () (set! success? (test-ref 'inherits?)))))
+      success?))
+  (with-test-assert "called with new test name"
+    (call-with-name "test"
+      (lambda () (equal? (test-ref 'name) "test")))))
+
+;;; Now the actual test procedures need to be tested. This is done by
+;;; running everything in a dummy test-info that is overridden at each
+;;; test site with new procedures.
+;;; 
+;;; The dummy test info does not escape from exceptions, like the default
+;;; `on-exception` handler. Hence exceptions inside of a `call-as-test`
+;;; will trip the actual exception handler for the meta test-info.
+
+(define-values (dummy-dto dummy-dict)
+  (inspect-test-info
+   (lambda (dto dict)
+     (define dummy (lambda _ #t))
+     (values dto
+             (dict-set! dto
+                        dict
+                        'setup-test dummy
+                        'before-test dummy
+                        'after-test dummy
+                        'report-test dummy
+                        'setup-group dummy
+                        'after-group dummy
+                        'before-group dummy
+                        'report-group dummy
+                        'on-exception dummy)))))
+
+(test-group "call-as-test, dummy dict"
+  (test-group "before test"
+    (with-test-assert "before-test skips tests when returning #f"
+      (parameterize ((test-info
+                      (list 'replace
+                            (dict-set! dummy-dto dummy-dict
+                                       'before-test
+                                       (lambda (name) #f)))))
+        (let ((called? #f))
+          (call-as-test "name"
+                        (lambda () (set! called? #t)))
+          (not called?)))
+      (with-test-assert "before-test gets the test name"
+        (define inside-test-info
+          (dict-set! dummy-dto dummy-dict
+                     'before-test
+                     (lambda (name)
+                       (unless (equal? name "1234")
+                         (raise "exception"))
+                       #t)))
+        (parameterize ((test-info
+                        (list 'replace inside-test-info)))
+          (let ((called? #f))
+            (call-as-test "1234"
+                          (lambda () (set! called? #t)))
+            called?)))))
+  (test-group "after test"
+    (let ((called? #f)
+          (pair (cons #f #f)))
+      (define inside-test-info
+        (dict-set! dummy-dto dummy-dict
+                   'after-test
+                   (lambda (previous-dto previous-dict)
+                     (set! called?
+                           (dict-ref previous-dto previous-dict
+                                     'after-test-test)))))
+      (with-test-assert "after test is called with previous test-info"
+        (parameterize ((test-info
+                        (list 'replace dummy-dto inside-test-info)))
+          (call-as-test #f
+                        (lambda ()
+                          (test-set! 'after-test-test #t))))
+        called?))
+    (let* ((pair (cons #f #f))
+           (inside-test-info
+            (dict-set! dummy-dto dummy-dict
+                       'after-test
+                       (lambda _ pair))))
+      (test-eq "return value of call-as-test is after-test"
+               pair
+               (parameterize ((test-info
+                               (list 'replace
+                                     dummy-dto inside-test-info)))
+                 (call-as-test #f (lambda () #f))))))
+  (with-test-assert "setup-test runs in dynamic extent"
+    (let ((global-name "setup-test-name")
+          (called? #f)
+          (pair (cons #f #f)))
+      (define inside-test-info
+        (dict-set! dummy-dto dummy-dict
+                   'setup-test
+                   (lambda ()
+                     (test-set! 'setup-test-test pair))))
+      (parameterize ((test-info (list 'replace dummy-dto inside-test-info)))
+        (call-as-test global-name
+                      (lambda ()
+                        (set! called? (eq? (test-ref 'setup-test-test) pair)))))
+      (and called? (not (test-contains? 'setup-test-test)))))
+  (test-group "on-exception"
+    (with-test-assert "not called"
+      (call/cc
+       (lambda (return)
+         (define inside-test-info
+           (dict-set! dummy-dto dummy-dict
+                      'exception-not-called?
+                      #t
+                      'on-exception
+                      (lambda (exn return)
+                        (test-set! 'exception-not-called? #f))
+                      'after-test
+                      (lambda (previous-dto previous-dict)
+                        (return (dict-ref previous-dto previous-dict
+                                          'exception-not-called?)))))
+         (parameterize ((test-info (list 'replace dummy-dto
+                                         inside-test-info)))
+           (call-as-test #f (lambda () #f)))
+         #f)))
+    (let* ((message "exception message")
+           (caught #f)
+           (inside-test-info
+            (dict-set! dummy-dto dummy-dict
+                       'on-exception
+                       (lambda (exn return)
+                         (set! caught exn)
+                         (return)))))
+      (with-test-assert "called"
+        (parameterize ((test-info
+                        (list 'replace dummy-dto
+                              inside-test-info)))
+          (call-as-test #f (lambda ()
+                             (raise message)))
+          caught)))))
+
+;;; ;;;;;;;;;;;;;;;;
+;;; Testing the default test handler, except for 'report-test.
+;;; 
+;;; The default report test writes to standard output, and the
+;;; return value of report-test is the return value of call-as-test
+;;; because report-test is called by after-test.
+;;; 
+;;; For `silent-dict`, the report procedures return the dto and 
+;;; dictionary inside the test/group. This is different from the
+;;; dictionary containing the test/group, which is returned using
+;;; `(inspect-test-info values)` inside the dynamic extent.
+
+(define silent-dict
+  (dict-set! default-dto default-test-info-dict
+             'report-test values
+             'report-group values))
+
+(test-group "call-as-test, some defaults"
+  (test-group "tests that success is true"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (call-as-test #f (lambda () (test-set! 'success? #t)))
+        (inspect-test-info values)))
+    (test-eqv "passed number" 1 (dict-ref dto dict 'passed))
+    (test-eqv "failed number" 0 (dict-ref dto dict 'failed))
+    (test-eqv "test number" 1 (dict-ref dto dict 'tests)))
+  (test-group "test that success is false"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (call-as-test #f (lambda () (test-set! 'success? #f)))
+        (inspect-test-info values)))
+    (test-eqv "passed number" 0 (dict-ref dto dict 'passed))
+    (test-eqv "failed number" 1 (dict-ref dto dict 'failed))
+    (test-eqv "test number" 1 (dict-ref dto dict 'tests)))
+  (test-group "success not set"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (call-as-test #f (lambda () #f))
+        (inspect-test-info values)))
+    (test-eqv "passed number" 0 (dict-ref dto dict 'passed))
+    (test-eqv "failed number" 1 (dict-ref dto dict 'failed))
+    (test-eqv "test number" 1 (dict-ref dto dict 'tests)))
+  (test-group "catching exceptions"
+    (define pair (cons #f #f))
+    (define-values (inner-dto inner-dict outer-dto outer-dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (let*-values (((inner-dto inner-dict) (call-as-test #f (lambda () (raise pair))))
+                      ((outer-dto outer-dict) (inspect-test-info values)))
+          (values inner-dto inner-dict outer-dto outer-dict))))
+    (test-eqv "exception" pair (dict-ref inner-dto inner-dict 'exception))
+    (test-eqv "passed number" 0 (dict-ref outer-dto outer-dict 'passed))
+    (test-eqv "failed number" 1 (dict-ref outer-dto outer-dict 'failed))
+    (test-eqv "test number" 1 (dict-ref outer-dto outer-dict 'tests))))
+
+(test-group "call-as-group"
+  (with-test-assert "group with no tests"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (call-as-group #f (lambda () #f))
+        (inspect-test-info values)))
+    (test-eqv "passed number" 0 (dict-ref dto dict 'passed))
+    (test-eqv "tests number" 0 (dict-ref dto dict 'tests))
+    (test-eqv "failed number" 0 (dict-ref dto dict 'failed))
+    (test-eqv "skipped number" 0 (dict-ref dto dict 'skipped)))
+  (with-test-assert "group with 1 test"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-group #f (with-test-assert #f #t))
+        (inspect-test-info values)))
+    (test-eqv "passed number" 1 (dict-ref dto dict 'passed))
+    (test-eqv "tests number" 1 (dict-ref dto dict 'tests))
+    (test-eqv "failed number" 0 (dict-ref dto dict 'failed))
+    (test-eqv "skipped number" 0 (dict-ref dto dict 'skipped)))
+  (test-group "group with multiple test"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-group #f
+          (call-as-test #f (lambda ()
+                            (test-set! 'success? #t)))
+          (call-as-test #f (lambda ()
+                            (test-set! 'success? #t)))
+          (call-as-test #f (lambda ()
+                            (test-set! 'success? #f)))
+          (test-skip-all
+           (call-as-test #f (lambda ()
+                             (test-set! 'success? #f)))))
+        (inspect-test-info values)))
+    (test-eqv "passed number" 2 (dict-ref dto dict 'passed))
+    (test-eqv "tests number" 4 (dict-ref dto dict 'tests))
+    (test-eqv "failed number" 1 (dict-ref dto dict 'failed))
+    (test-eqv "skipped number" 1 (dict-ref dto dict 'skipped)))
+  (with-test-assert "nested groups"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-group #f
+          (with-test-assert #f #t)
+          (test-group #f (with-test-assert #f #f)))
+        (inspect-test-info values)))
+    (test-eqv "passed number" 1 (dict-ref dto dict 'passed))
+    (test-eqv "tests number" 2 (dict-ref dto dict 'tests))
+    (test-eqv "failed number" 1 (dict-ref dto dict 'failed))
+    (test-eqv "skipped number" 0 (dict-ref dto dict 'skipped))))
+
+(test-group "test application"
+  (with-test-assert "true"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-application "not" (not not) (arg #f))
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'passed)))
+  (with-test-assert "false"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-application "not" (not not) (arg #t))
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'failed))))
+
+(test-group "test-equal"
+  (with-test-assert "true"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-equal "equal" "abc" "abc")
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'passed)))
+  (with-test-assert "false"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-equal "equal" "abc" "def")
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'failed))))
+
+(test-group "test-eq"
+  (with-test-assert "true"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-eq "eq" 'abc 'abc)
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'passed)))
+  (with-test-assert "false"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-eq "eq" 'abc 'def)
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'failed))))
+
+(test-group "test-eqv"
+  (with-test-assert "true"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-eqv "eqv" 100 100)
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'passed)))
+  (with-test-assert "false"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-eqv "eqv" 100 200)
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'failed))))
+
+(test-group "test-approximate"
+  (with-test-assert "true"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-approximate "approx" 1 1.001 0.01)
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'passed)))
+  (with-test-assert "false"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (test-approximate "approx" 100 1.01 0.01)
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'failed))))
+
+(test-group "test-error"
+  (with-test-assert "thrown exception"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (with-test-error #f
+          (lambda (ex) (equal? ex "exception"))
+          (raise "exception"))
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'passed)))
+  (with-test-assert "no thrown exception"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (with-test-error #f
+          (lambda (ex) #t)
+          #f)
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'failed)))
+  (with-test-assert "incorrectly thrown exception"
+    (define-values (dto dict)
+      (parameterize ((test-info (list 'replace default-dto silent-dict)))
+        (with-test-error #f number? (raise "exception"))
+        (inspect-test-info values)))
+    (eqv? 1 (dict-ref dto dict 'failed))))
+
+(test-exit)
diff --git a/tests/run.scm b/tests/run.scm
new file mode 100644
index 0000000..569ef2e
--- /dev/null
+++ b/tests/run.scm
@@ -0,0 +1,29 @@
+#| Copyright © 2025 Peter McGoron
+ |
+ | Permission is hereby granted, free of charge, to any person obtaining
+ | a copy of this software and associated documentation files (the
+ | “Software”), to deal in the Software without restriction, including
+ | without limitation the rights to use, copy, modify, merge, publish,
+ | distribute, sublicense, and/or sell copies of the Software, and to
+ | permit persons to whom the Software is furnished to do so, subject to
+ | the following conditions:
+ |
+ | The above copyright notice and this permission notice shall be included
+ | in all copies or substantial portions of the Software.
+ |
+ | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND,
+ | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
+ | NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+ | DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+ | OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+ | THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ |#
+
+(cond-expand
+  (chicken-5 (import r7rs))
+  (else))
+
+(import (conspire) (srfi 225) (scheme load))
+(include "impl.scm")
+