From 68986fe0410584c6934c835bb0ee784655f5f8c5 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Tue, 11 Jan 2022 22:01:23 -0800
Subject: Move scheme compiler into a separate directory.

---
 testing.csc | 81 -------------------------------------------------------------
 1 file changed, 81 deletions(-)
 delete mode 100644 testing.csc

(limited to 'testing.csc')

diff --git a/testing.csc b/testing.csc
deleted file mode 100644
index a0180e6..0000000
--- a/testing.csc
+++ /dev/null
@@ -1,81 +0,0 @@
-(define-library (csc testing)
-  (export
-    assert
-    assert-equal
-    assert-raises
-    test
-    test-main)
-  (import (scheme base)
-          (only (csc format)
-            printf
-            sprintf))
-  (begin
-
-
-    (define *all-tests-succeeded* #t)
-
-
-    (define (set-all-succeeded! val) (set! *all-tests-succeeded* val))
-
-
-    (define-record-type <test-handle>
-      (make-test-handle test-name)
-      test-handle?
-      (test-name test-name set-name!))
-
-
-    (define-record-type <test-error>
-      (make-test-error)
-      test-error?)
-
-
-    (define *test-handle* (make-test-handle "global"))
-
-
-    (define-syntax test
-      (syntax-rules ()
-        ((test name body body* ...)
-         (begin
-           (set-name! *test-handle* (symbol->string 'name))
-           (printf "=== RUN   {}\n" 'name)
-           (guard (e ((test-error? e)
-                      (printf "--- FAIL: {}\n" 'name)
-                      (set-all-succeeded! #f)))
-             body body* ...
-             (printf "--- PASS: {}\n" 'name))))))
-
-
-    (define (fatalf format-string . format-args)
-      (printf "{}: {}\n" (test-name *test-handle*) (apply sprintf format-string format-args))
-      (raise (make-test-error)))
-
-
-    (define-syntax assert
-      (syntax-rules ()
-        ((assert expr)
-         (unless expr
-           (fatalf "(assert {}) failed." 'expr)))))
-
-
-    (define-syntax assert-equal
-      (syntax-rules ()
-        ((assert-equal left right)
-         (let ((x left)
-               (y right))
-           (unless (equal? x y)
-             (fatalf "Fatal: {} is not equal to {}.\nleft is {}\nright is {}" 'left 'right x y))))))
-
-
-    (define-syntax assert-raises
-      (syntax-rules ()
-        ((assert-raises predicate body body* ...)
-         (assert
-           (guard (e ((predicate e) #t))
-             body body* ...
-             #f)))))
-
-
-    (define (test-main)
-      (if *all-tests-succeeded*
-          (printf "PASS\n")
-        (printf "FAIL\n")))))
-- 
cgit v1.3.1