In the beginning there was darkness

tap-srfi-64.egg

@@ -0,0 +1,11 @@
+;; -*- Scheme -*-
+((author "Daniel Ziltener")
+ (synopsis "An SRFI-64 test runner that produces TAP-compatible output")
+ (category testing)
+ (license "BSD")
+ (version "0.9")
+ (dependencies r7rs srfi-64 srfi-152 srfi-197)
+
+ (components
+  (extension tap-srfi-64
+             (csc-options "-X" "r7rs" "-R" "r7rs" "-sJ"))))

tap-srfi-64.release-info

@@ -0,0 +1,4 @@
+;; -*- Scheme -*-
+(repo git "https://gitea.lyrion.ch/chicken/tap-srfi-64.git")
+(uri targz "https://gitea.lyrion.ch/chicken/tap-srfi-64/archive/{egg-release}.tar.gz")
+(release "0.9")

tap-srfi-64.scm

@@ -0,0 +1,83 @@
+(define-library (tap srfi 64)
+  (import (r7rs)
+          (chicken string)
+          (srfi 1)
+          (srfi 64)
+          (srfi 152)
+          (srfi 197))
+  (export tap-test-runner)
+  (begin
+
+    (define (test-name runner)
+      (string-append
+       (string-join (test-runner-group-path runner) " - ")
+       ;; " - " (test-runner-test-name runner)
+       ))
+
+    (define (al-ref alist key)
+      (chain (let ((al-var (assq key alist)))
+               (if al-var
+                   (cdr al-var)
+                   "#f"))
+             (string-split _ "\n")
+             (string-join _ "\n      ")))
+
+    (define (tap-test-runner)
+      (let ((runner (test-runner-null))
+            (testcounter 0))
+        (print "TAP version 14\n")
+        (test-runner-on-test-end! runner
+          (lambda (runner)
+            (set! testcounter (+ testcounter 1))
+            (let ((result (test-result-alist runner)))
+              (case (cdr (assq 'result-kind result))
+                ('pass (print
+                        (string-append
+                         "ok " (number->string testcounter) " - "
+                         (test-name runner))))
+                ('fail (print
+                        (string-append
+                         "not ok " (number->string testcounter) " - "
+                         (test-name runner) "\n"
+                         "  ---\n"
+                         "  message: The test failed, but was expected to pass. \n"
+                         "  severity: fail\n"
+                         "  data:\n"
+                         "    got: |\n      "
+                         (al-ref result 'actual-value) "\n"
+                         "    expect: |\n      "
+                         (al-ref result 'expected-value) "\n"
+                         "  at:\n"
+                         "    file: " (al-ref result 'source-file) "\n"
+                         "    line: " (al-ref result 'source-line) "\n"
+                         "  ...")))
+                ('xfail (print
+                         (string-append
+                          "ok " (number->string testcounter) " - "
+                          (test-name runner))))
+                ('xpass (print
+                         (string-append
+                          "not ok " (number->string testcounter) " - "
+                          (test-name runner) "\n"
+                          "  ---\n"
+                          "  message: The test passed, but was expected to fail. \n"
+                          "  severity: fail\n"
+                          "  data:\n"
+                          "    got: |\n      "
+                          (al-ref result 'actual-error) "\n"
+                          "    expect: |\n      "
+                          (al-ref result 'expected-error) "\n"
+                          "  at:\n"
+                          "    file: " (al-ref result 'source-file) "\n"
+                          "    line: " (al-ref result 'source-line) "\n"
+                          "  ...\n")))
+                ('skip (print
+                        (string-append
+                         "ok " (number->string testcounter) " - "
+                         (test-name runner) " # SKIP")))))))
+        (test-runner-on-final! runner
+          (lambda (runner)
+            (print (string-append "1.." (number->string testcounter) "\n"))))
+        runner))
+
+    ))

tap-srfi-64.wiki

@@ -0,0 +1,61 @@
+[[tags: egg]]
+
+== TAP-SRFI-64
+
+[[toc:]]
+
+=== Description
+
+An SRFI-64 test runner that produces TAP-compatible output
+
+=== Dependencies
+
+SRFIs 64, 152, and 197.
+
+=== Usage
+
+This library only exposes tap-test-runner. You can run your tests with it by importing this library and adding
+
+    (test-runner-factory (lambda () (tap-test-runner)))
+
+=== About this egg
+
+==== Source
+
+The source code is hosted at [[https://gitea.lyrion.ch/chicken/tap-srfi-64]].
+
+==== Author
+
+Daniel Ziltener
+
+==== Version History
+
+; 0.9 : Initial Release
+
+==== License
+
+  Copyright (C) 2022 Daniel Ziltener
+
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+      * Redistributions of source code must retain the above copyright
+        notice, this list of conditions and the following disclaimer.
+      * Redistributions in binary form must reproduce the above copyright
+        notice, this list of conditions and the following disclaimer in the
+        documentation and/or other materials provided with the distribution.
+      * Neither the name of the <organization> nor the
+        names of its contributors may be used to endorse or promote products
+        derived from this software without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+  DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
+  DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+  LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.