diff options
| author | Rose Hogenson <rhogenson@posteo.net> | 2022-01-11 22:01:23 -0800 |
|---|---|---|
| committer | Rose Hogenson <rhogenson@posteo.net> | 2022-01-11 22:01:23 -0800 |
| commit | 68986fe0410584c6934c835bb0ee784655f5f8c5 (patch) | |
| tree | d51bc2f3e09df35ef81b7a0c462ff555b4344701 /testing.csc | |
| parent | Add a first implementation of a macro expander. (diff) | |
| download | chromatopelma-68986fe0410584c6934c835bb0ee784655f5f8c5.tar.zst | |
Move scheme compiler into a separate directory.
Diffstat (limited to 'testing.csc')
| -rw-r--r-- | testing.csc | 81 |
1 files changed, 0 insertions, 81 deletions
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"))))) |
