Advertisement
Guest User

Untitled

a guest
Jul 30th, 2015
217
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.93 KB | None | 0 0
  1. ;;; Common Lisp testing framework
  2.  
  3. ;;; Copyright 2015 Dave Astels
  4. ;;; MIT License
  5.  
  6.  
  7. (defvar number-of-tests 0)
  8. (defvar number-of-failures 0)
  9.  
  10. (defvar failure-messages '())
  11.  
  12. (defvar verbose-tests nil)
  13. (defvar context-name "")
  14.  
  15.  
  16. (defun reset-testing ()
  17. (setf number-of-tests 0)
  18. (setf number-of-failures 0)
  19. (setf number-of-errors 0)
  20. (setf failure-messages '())
  21. (setf error-messages '())
  22. (setf verbose-tests nil))
  23.  
  24.  
  25. (defmacro context (label &rest body)
  26. (if (not (or (symbolp label) (stringp label)))
  27. (error "The label of a describe must be a symbol or string.")
  28. `(progn (when verbose-tests
  29. (format t "Context: ~A~%" ,label))
  30. (setf context-name ,label)
  31. ,@body)))
  32.  
  33.  
  34. (defun log-pass (msg)
  35. (setf number-of-tests (1+ number-of-tests))
  36. (when verbose-tests
  37. (format t " ~A - ok~%" msg)))
  38.  
  39.  
  40. (defun log-failure (prefix msg)
  41. (setf number-of-failures (1+ number-of-failures))
  42. (let ((failure-message (format nil "~A: ~A - ~A" context-name prefix msg)))
  43. (setf failure-messages (cons failure-message failure-messages))
  44. (when verbose-tests
  45. (format t " ~A - failed: ~A~%" prefix msg))))
  46.  
  47.  
  48. (defmacro assert-true (sexpr)
  49. `(let ((actual (eval ,sexpr))
  50. (msg (format nil "(assert-true ~A)" ',sexpr)))
  51. (if actual
  52. (log-pass msg)
  53. (log-failure msg "expected true, but was false"))))
  54.  
  55.  
  56. (defmacro assert-false (sexpr)
  57. `(let ((actual (eval ,sexpr))
  58. (msg (format nil "(assert-false ~A)" ',sexpr)))
  59. (if (not actual)
  60. (log-pass msg)
  61. (log-failure msg "expected false, but was true"))))
  62.  
  63.  
  64. (defmacro assert-null (sexpr)
  65. `(let ((actual (eval ,sexpr))
  66. (msg (format nil "(assert-null ~A)" ',sexpr)))
  67. (if (null actual)
  68. (log-pass msg)
  69. (log-failure msg "expected null, but wasn't"))))
  70.  
  71.  
  72. (defmacro assert-not-null (sexpr)
  73. `(let ((actual (eval ,sexpr))
  74. (msg (format nil "(assert-not-null ~A)" ',sexpr)))
  75. (if (not (null actual))
  76. (log-pass msg)
  77. (log-failure msg "expected not null, but was"))))
  78.  
  79.  
  80. (defmacro assert-eq (sexpr expected-sexpr)
  81. `(let* ((actual ,sexpr)
  82. (expected ,expected-sexpr)
  83. (msg (format nil "(assert-eq ~A ~A)" ',sexpr ',expected-sexpr)))
  84. (if (eq actual expected)
  85. (log-pass msg)
  86. (log-failure msg (format nil "expected ~A, but was ~A" expected actual)))))
  87.  
  88.  
  89. (defmacro assert-neq (sexpr expected-sexpr)
  90. `(let* ((actual ,sexpr)
  91. (expected ,expected-sexpr)
  92. (msg (format nil "(assert-neq ~A ~A)" ',sexpr ',expected-sexpr)))
  93. (if (not (eq actual expected))
  94. (log-pass msg)
  95. (log-failure msg (format nil "did not expect ~A, but it was" expected)))))
  96.  
  97.  
  98. (defun run-tests (test-dir &optional (verbose nil))
  99. (setf failure-messages '())
  100. (setf verbose-tests verbose)
  101. (mapcar #'load (cl-fad:list-directory test-dir))
  102. (format t "~%Failures:~%")
  103. (mapcar (lambda (m) (format t " ~A~%" m))
  104. failure-messages))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement