test.scm 1.4 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647
  1. ;; macros originally from https://notabug.org/eq/testscm
  2. (define-syntax test
  3. (syntax-rules ()
  4. ((test name success text)
  5. (begin
  6. (display (format #f
  7. "~a: ~a\x1b[39m ~a\n"
  8. name
  9. (if success "\x1b[32mSUCCESS" "\x1b[31mFAILURE")
  10. text))
  11. (list (if success 0 1) 1)))
  12. ((test name success input result expected)
  13. (test name success
  14. (if success
  15. (format #f "~a -> ~a" input result)
  16. (format #f "~a -> ~a (expected ~a)" input result expected))))
  17. ((test name input result expected)
  18. (test name (equal? expected result) input result expected))))
  19. (define-syntax test-group
  20. (syntax-rules ()
  21. ((test-group name (test tname args ...) ...)
  22. (let
  23. ((count
  24. (map (lambda (x) (apply + x))
  25. (map list
  26. (test (string-append name tname) args ...) ...))))
  27. (when (> (string-length name) 0)
  28. (display (format #f "~a: ~a out of ~a tests failed\n"
  29. name
  30. (car count)
  31. (cadr count))))
  32. count))))
  33. (define-syntax test-func
  34. (syntax-rules ()
  35. ((test-func name f expected)
  36. (test name (equal? f expected) (quote f) f expected))))
  37. (add-to-load-path (dirname (current-filename)))
  38. (load-from-path "test/vec.scm")
  39. (test-group
  40. "/"
  41. (test-vec "vec.scm/"))