Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

forgot to wrap inline cond-expand defs in begin

Browse source
This commit is contained in:
Alex Shinn 2020-09-01 22:27:59 +09:00
parent e7e034dea0
commit e5cf364360
2 changed files with 43 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
lib/chibi/diff-test.sld
View file

@ -7,23 +7,24 @@
(else (else
;; inline (chibi test) to avoid circular dependencies in snow ;; inline (chibi test) to avoid circular dependencies in snow
;; installations ;; installations
(define-syntax test (begin
(syntax-rules () (define-syntax test
((test expect expr) (syntax-rules ()
(test 'expr expect expr)) ((test expect expr)
((test name expect expr) (test 'expr expect expr))
(guard (exn (else (display "!\nERROR: ") (write name) (newline) ((test name expect expr)
(write exn) (newline))) (guard (exn (else (display "!\nERROR: ") (write name) (newline)
(let* ((res expr) (write exn) (newline)))
(pass? (equal? expect expr))) (let* ((res expr)
(display (if pass? "." "x")) (pass? (equal? expect expr)))
(cond (display (if pass? "." "x"))
((not pass?) (cond
(display "\nFAIL: ") (write name) (newline)))))))) ((not pass?)
(define (test-begin name) (display "\nFAIL: ") (write name) (newline))))))))
(display name)) (define (test-begin name)
(define (test-end) (display name))
(newline)))) (define (test-end)
(newline)))))
(begin (begin
(define (run-tests) (define (run-tests)
(test-begin "diff") (test-begin "diff")

46
lib/chibi/optional-test.sld
View file

@ -6,27 +6,31 @@
(else (else
;; inline (chibi test) to avoid circular dependencies in snow ;; inline (chibi test) to avoid circular dependencies in snow
;; installations ;; installations
(define-syntax test (begin
(syntax-rules () (define-syntax test
((test expect expr) (syntax-rules ()
(test 'expr expect expr)) ((test expect expr)
((test name expect expr) (test 'expr expect expr))
(guard (exn (else (display "!\nERROR: ") (write name) (newline) ((test name expect expr)
(write exn) (newline))) (guard (exn (else (display "!\nERROR: ") (write name) (newline)
(let* ((res expr) (write exn) (newline)))
(pass? (equal? expect expr))) (let* ((res expr)
(display (if pass? "." "x")) (pass? (equal? expect expr)))
(cond (display (if pass? "." "x"))
((not pass?) (cond
(display "\nFAIL: ") (write name) (newline)))))))) ((not pass?)
(define-syntax test-error (display "\nFAIL: ") (write name) (newline))))))))
(syntax-rules () (define-syntax test-assert
((test-error expr) (syntax-rules ()
(test-assert (guard (exn (else #t)) expr #f))))) ((test-assert expr) (test #t expr))))
(define (test-begin name) (define-syntax test-error
(display name)) (syntax-rules ()
(define (test-end) ((test-error expr)
(newline)))) (test-assert (guard (exn (else #t)) expr #f)))))
(define (test-begin name)
(display name))
(define (test-end)
(newline)))))
(export run-tests) (export run-tests)
(begin (begin
(define (run-tests) (define (run-tests)