diff --git a/.github/workflows/tests.yaml b/.github/workflows/tests.yaml new file mode 100644 index 0000000..685c834 --- /dev/null +++ b/.github/workflows/tests.yaml @@ -0,0 +1,30 @@ +on: [push] +jobs: + tests: + strategy: + matrix: + os: + - ubuntu-latest + # - macos-latest + # - windows-latest + lisp: + - sbcl-bin + # - ecl + # - ccl-bin + # - abcl-bin + # - clasp-bin + # - cmu-bin + # - clisp-head + runs-on: ${{ matrix.os }} + env: + LISP: ${{ matrix.lisp }} + steps: + - uses: actions/checkout@v4 + - uses: 40ants/setup-lisp@v4 + with: + asdf-system: sijo-doctest + qlfile-template: | + dist ultralisp http://dist.ultralisp.org + - uses: 40ants/run-tests@v2 + with: + asdf-system: sijo-doctest diff --git a/.gitignore b/.gitignore index 816e5d9..9366193 100644 --- a/.gitignore +++ b/.gitignore @@ -1,17 +1,18 @@ -*.FASL -*.fasl -*.lisp-temp -*.dfsl -*.pfsl -*.d64fsl -*.p64fsl -*.lx64fsl -*.lx32fsl -*.dx64fsl -*.dx32fsl -*.fx64fsl -*.fx32fsl -*.sx64fsl -*.sx32fsl -*.wx64fsl -*.wx32fsl +*.FASL +*.fasl +*.fas +*.lisp-temp +*.dfsl +*.pfsl +*.d64fsl +*.p64fsl +*.lx64fsl +*.lx32fsl +*.dx64fsl +*.dx32fsl +*.fx64fsl +*.fx32fsl +*.sx64fsl +*.sx32fsl +*.wx64fsl +*.wx32fsl diff --git a/CHANGELOG.org b/CHANGELOG.org new file mode 100644 index 0000000..93d9f85 --- /dev/null +++ b/CHANGELOG.org @@ -0,0 +1,43 @@ +* Changelog +All notable changes to this project will be documented in this file. + +The format is based on [[https://keepachangelog.com/en/1.1.0][Keep a Changelog]], and this project *DOES NOT* adhere to [[https://semver.org/spec/v2.0.0.html][Semantic +Versioning]]. + +** [[https://github.com/simendsjo/sijo-doctest/compare/v0.2..v0.3][0.3.0]] - 2024-03-11 +*** Added +- Support Embedded Common Lisp (ECL) +- Support Clozure Common Lisp (CCL) +- Support Armed Bear Common Lisp (ABCL) +- ~test-docstring~ for testing strings -- simplifies testing +- ~test-variable~ for testing variables +*** Changed +- Don't require an exact error, but rather a subclass of the expected error, + e.g. expecting ~type-error~ will allow a subclass like ~simple-type-error~. +- The general ~test~ is exported +- ~test~ runs ~test-package~ for ~package~ +- ~test~ supports ~null~ +- ~test~ supports ~string~ +- ~test~ for symbol will test both variable and function/macro bound to that symbol +- Number of failed/passed tests is always returned, also when there are no + doctests for a thing, rather than ~nil~ +*** Deprecated +*** Removed +*** Fixed +- ~test-package~ only includes symbols for the package under test +- ~test-package~ works for macros +*** Security + +** [[https://github.com/simendsjo/sijo-doctest/commit/039516e828b5737569350a13ffc90c2d8346ad8c][0.2.0]] - 2024-03-01 +*** Added +- ~test-package~ function to test all functions in a package +*** Changed +- Tweaked to evaluate expected results to avoid problems with ~fset~ and + readtables; ~#{||}~ cannot be used, and ~(fset:empty-map)~ neither +- Improved working with multiple values +- Print only when tests are failing (useful when testing entire packages) +*** Deprecated +*** Removed +*** Fixed +- ~run-doctests~ doesn't throw on empty docstring (triggered eof error) +*** Security diff --git a/gpl-3.0.txt b/LICENSE similarity index 100% rename from gpl-3.0.txt rename to LICENSE diff --git a/README.org b/README.org index 003564c..66758c1 100644 --- a/README.org +++ b/README.org @@ -1,5 +1,10 @@ -Doctests for Lisp +[[https://github.com/simendsjo/sijo-doctest/actions/workflows/tests.yaml/badge.svg][Build badge]] +* Doctests for Lisp + +See [[file:CHANGELOG.org][CHANGELOG]]. + +** Installation Clone repository #+begin_src bash git clone git@github.com:simendsjo/sijo-doctest.git ~/quicklisp/local-projects/sijo-doctest @@ -10,6 +15,7 @@ Load library (ql:quickload :sijo-doctest) #+end_src +** Usage Write some doctests #+begin_src lisp (defun square (x) @@ -24,27 +30,12 @@ Write some doctests (* x x)) #+end_src -See [[file:doctest.lisp::defun test (thing &key (output t)][doctest.lisp::test]] for full documentation or look at the documentation for -the function directly -#+begin_src lisp :wrap quote :exports both -(documentation 'sijo-doctest::test 'function) -#+end_src - -#+RESULTS: -#+begin_quote -Test extracts and tests code snippets embedded in the documentation string - of . It returns the number of tests failed and passed and prints a - description to . - - In order to have...[sly-elided string of length 3067] -#+end_quote - Test your package #+begin_src lisp (sijo-doctest:test-package :your-own-package) #+end_src -* Documentation for ~sijo-doctest::test~ +** Documentation for ~sijo-doctest::test~ Warning: This is bound to get out of date, so look at the documentation in the source. @@ -80,13 +71,16 @@ Test extracts and tests code snippets embedded in the documentation string 2) (values 1 2) instead. If you test a thing that doesn't have a documentation string, test will - return NIL. + return (values 0 0). + ECL NOTE: I pass an empty string here as redefining a function in ECL won't + remove the old docstring unless a docstring is explicitly passed. >> (defun sqr (x) + "" (* x x)) 'SQR >> (sijo-doctest::test #'sqr) - NIL + (values 0 0) If you need to test that a function signals a condition for certain inputs you can use the name of the condition as the expected return value. @@ -159,12 +153,3 @@ Test extracts and tests code snippets embedded in the documentation string Results for SQR (FUNCTION): 1 of 4 failed.| (values 1 3) #+end_example - -* Changelog -This fork has some minor differences to the upstream version: -- Tweaked to evaluate expected results to avoid problems with ~fset~ and - readtables; ~#{||}~ cannot be used, and ~(fset:empty-map)~ neither -- Improved working with multiple values -- Added a ~test-package~ function to test all functions in a package -- Print only when tests are failing (useful when testing entire packages) -- ~run-doctests~ doesn't throw on empty docstring (triggered eof error) diff --git a/sijo-doctest.asd b/sijo-doctest.asd index 4066ee7..60f8fc3 100644 --- a/sijo-doctest.asd +++ b/sijo-doctest.asd @@ -1,6 +1,21 @@ (defsystem :sijo-doctest + :in-order-to ((test-op (test-op :sijo-doctest/tests))) :description "Doctests for Common Lisp" - :version "0.2" + :version "0.3" :author "Johan Lindberg (Pulp Software) , Simen Endsjø " :licence "GPL" + :serial t + :pathname "src/" + :components ((:file "doctest"))) + +(defsystem :sijo-doctest/tests + :depends-on (#:sijo-doctest + #:lisp-unit2) + :perform (test-op (o c) + (eval (read-from-string " + (lisp-unit2:with-summary () + (lisp-unit2:run-tests + :package :sijo-doctest/tests + :name :sijo-doctest))"))) + :pathname "tests/" :components ((:file "doctest"))) diff --git a/doctest.lisp b/src/doctest.lisp similarity index 72% rename from doctest.lisp rename to src/doctest.lisp index 3844a8c..28d37fe 100644 --- a/doctest.lisp +++ b/src/doctest.lisp @@ -17,7 +17,10 @@ (defpackage :sijo-doctest (:use #:cl) - (:export #:test-function + (:export #:test + #:test-docstring + #:test-variable + #:test-function #:test-macro #:test-file #:test-package)) @@ -26,14 +29,12 @@ (defun whitespace-p (c) "Returns T if is a whitespace character, otherwise NIL." - - (or (equal #\Space c) - (equal #\Tab c) - (equal #\Newline c))) + (or (eql #\Space c) + (eql #\Tab c) + (eql #\Newline c))) (defun remove-ws (string) "Return (as a string) with *all* whitespace characters removed." - (if (stringp string) (remove-if #'whitespace-p (copy-seq string)) (remove-if #'whitespace-p (copy-seq (string string))))) @@ -42,7 +43,7 @@ (string-equal (remove-ws string1) (remove-ws string2))) (defun run-doctest (test-form expected-result expected-output output count) - (let* ((test-form-signaled-condition 'NIL) + (let* ((test-form-signaled-condition nil) (actual-output (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t)) @@ -59,20 +60,20 @@ (expected-output-matches-actual-output (if expected-output (string-equal-ignore-ws actual-output expected-output) - T)) - (result T)) + t)) + (result t)) (if test-form-signaled-condition - (when (not (equalp (type-of (car actual-result)) - (car expected-result))) + (unless (subtypep (type-of (car actual-result)) + (car expected-result)) (unless (subtypep (type-of (car actual-result)) 'warning) - (setf result 'NIL) + (setf result nil) (format output "~&[~A] ~A signaled a ~A: ~A, expected ~A.~%" count test-form (type-of (car actual-result)) (car actual-result) (car expected-result)))) (unless (and (equalp actual-result expected-result) expected-output-matches-actual-output) - (setf result 'NIL) + (setf result nil) (if expected-output-matches-actual-output (format output "~&[~A] ~A returned~{ ~A~}, expected~{ ~A~}.~%" count test-form @@ -87,7 +88,6 @@ (defun run-doctests (docstring output) "Run-doctests is used by the test functions to perform the actual work. It returns the number of tests failed and passed and prints to ." - (let ((tests-failed 0) (tests-passed 0) (count 0)) @@ -100,12 +100,11 @@ (whitespace-p (peek-char nil docstring))) (let ((test-form (read docstring)) (expected-result (list (read docstring))) - (expected-output 'NIL)) + (expected-output nil)) (when (and (symbolp (car expected-result)) (equal (string (car expected-result)) "->")) (setf expected-output (read docstring)) (setf expected-result (list (read docstring)))) - (if (run-doctest test-form (car expected-result) expected-output @@ -113,10 +112,8 @@ (incf count)) (incf tests-passed) (incf tests-failed)))))) - (values tests-failed tests-passed))) -#+(and) (defun test (thing &key (output t)) "Test extracts and tests code snippets embedded in the documentation string of . It returns the number of tests failed and passed and prints a @@ -143,13 +140,16 @@ 2) (values 1 2) instead. If you test a thing that doesn't have a documentation string, test will - return NIL. + return (values 0 0). + ECL NOTE: I pass an empty string here as redefining a function in ECL won't + remove the old docstring unless a docstring is explicitly passed. >> (defun sqr (x) + \"\" (* x x)) 'SQR >> (sijo-doctest::test #'sqr) - NIL + (values 0 0) If you need to test that a function signals a condition for certain inputs you can use the name of the condition as the expected return value. @@ -221,31 +221,60 @@ -> |[4] (SQR 2) printed \"2 * 2 = 4\", expected \"Blah blah blah\". Results for SQR (FUNCTION): 1 of 4 failed.| (values 1 3)" - - (cond ((functionp thing) + (cond ((null thing) + (values 0 0)) + ((stringp thing) + (test-docstring thing :output output)) + ((functionp thing) (test-function thing :output output)) ((pathnamep thing) (test-file thing :output output)) - ((and (symbolp thing) - (macro-function thing)) - (test-macro thing :output output)) - + ((packagep thing) + (test-package thing :output output)) + ((symbolp thing) + (let ((total-failed 0) + (total-passed 0)) + (flet ((collect (fn) + (multiple-value-bind (failed passed) (funcall fn) + (incf total-failed failed) + (incf total-passed passed)))) + (collect (lambda () (test-variable thing :output output))) + (cond + ((macro-function thing) + (collect (lambda () (test-macro thing :output output)))) + ((fboundp thing) + (collect (lambda () (test-function (symbol-function thing) :output output))))) + (values total-failed total-passed)))) (t (error "~&No suitable testing-function available for ~A~%" thing)))) +(defun test-variable (thing &key (output t)) + (test-docstring (documentation thing 'variable) :output output)) + +(defun test-docstring (documentation &key (output t)) + (with-input-from-string (docstring (or documentation "")) + (run-doctests docstring output))) + +(defun extract-function-documentation-and-name (function) + ;; ABCL doesn't give documentation for (documentation function 'function) for all expressions. + ;; We try function-lambda-expression too + (multiple-value-bind (lambda-expression closure-p name) (function-lambda-expression function) + (declare (ignore closure-p)) + (values (or (documentation function 'function) (third lambda-expression)) + (symbol-name name)))) + (defun test-function (function &key (output t)) "Test-function extracts and tests code snippets in 's documentation string. It returns the number of tests failed and passed and prints a description to . See also the documentation string for test." - - (when (documentation function 'function) - (let ((function-name (third (multiple-value-list (function-lambda-expression function))))) - (multiple-value-bind (tests-failed tests-passed) - (with-input-from-string (docstring (documentation function 'function)) - (run-doctests docstring output)) - (print-results function-name 'function output tests-failed tests-passed))))) + (multiple-value-bind (documentation function-name) (extract-function-documentation-and-name function) + (if documentation + (multiple-value-bind (tests-failed tests-passed) + (test-docstring documentation :output output) + (print-results function-name 'function output tests-failed tests-passed)) + (values 0 0)))) (defun test-macro (macro &key (output t)) "Test-macro extracts and tests code snippets in 's documentation string. @@ -253,13 +282,12 @@ . See also the documentation string for test." - - (when (documentation macro 'function) - (let ((macro-name (third (multiple-value-list (function-lambda-expression (macro-function macro)))))) - (multiple-value-bind (tests-failed tests-passed) - (with-input-from-string (docstring (documentation macro 'function)) - (run-doctests docstring output)) - (print-results macro-name 'macro output tests-failed tests-passed))))) + (if (documentation macro 'function) + (let ((macro-name (third (multiple-value-list (function-lambda-expression (macro-function macro)))))) + (multiple-value-bind (tests-failed tests-passed) + (test-docstring (documentation macro 'function) :output output) + (print-results macro-name 'macro output tests-failed tests-passed))) + (values 0 0))) (defun test-file (filename &key (output t)) @@ -268,17 +296,20 @@ . See also the documentation string for test." - (multiple-value-bind (tests-failed tests-passed) (with-open-file (docstring filename :direction :input) - (run-doctests docstring output)) + (test-docstrting docstring :output output)) (print-results filename 'file output tests-failed tests-passed))) -(defun test-package (package) - (let ((*package* (find-package package))) - (do-symbols (symbol (find-package package)) - (when (fboundp symbol) - (test-function (symbol-function symbol)))))) +(defun test-package (package &key (output t)) + (let ((total-failed 0) + (total-passed 0)) + (let ((*package* (find-package package))) + (do-symbols (symbol (find-package package)) + (when (eq *package* (symbol-package symbol)) + (multiple-value-bind (tests-failed tests-passed) (test symbol :output output) + (incf total-failed tests-failed) + (incf total-passed tests-passed))))))) (defun print-results (test-name test-type output tests-failed tests-passed) (when (> tests-failed 0) diff --git a/tests/doctest.lisp b/tests/doctest.lisp new file mode 100644 index 0000000..c41cd8e --- /dev/null +++ b/tests/doctest.lisp @@ -0,0 +1,70 @@ +(defpackage :sijo-doctest/tests + (:use #:cl #:lisp-unit2) + (:local-nicknames (#:doctest #:sijo-doctest))) + +(in-package :sijo-doctest/tests) + +(defun assert-doctest (expected documentation &key (expected-output "")) + (let* ((*standard-output* (make-string-output-stream)) + (result (multiple-value-list (assert-equalp expected (doctest:test documentation))))) + (let* ((actual-output (get-output-stream-string *standard-output*)) + (expected-output (if (string-equal "" actual-output) + expected-output + ;; The output always ends in a newline, so we + ;; inject it to simplify the tests + (format nil "~a~%" expected-output)))) + (assert-equalp expected-output actual-output)) + (values (first result) (second result)))) + + +(define-test doctest () + ;; Test the documentation for the library itself + (multiple-value-bind (failed passed) (doctest:test #'doctest:test) + (assert-eql 0 failed) + (assert-true (> passed 0))) + ;; No tests reports 0/0 + (assert-doctest (values 0 0) nil) + (assert-doctest (values 0 0) "") + (assert-doctest (values 0 0) ">>> t nil") + (assert-doctest (values 0 0) "> t nil") + ;; Single pass + (assert-doctest (values 0 1) ">> t t") + ;; Single fail + (assert-doctest (values 1 0) ">> t nil" + :expected-output "[1] T returned T, expected NIL.") + ;; Error + (assert-doctest (values 0 1) ">> (error 'foo) 'error") + ;; Catches subtypes + (assert-doctest (values 0 1) ">> (error 'foo) 'condition") + ;; Ok output, ok result + (assert-doctest (values 0 1) ">> (format t \"foo\") -> \"foo\" nil") + ;; Ok output, fail result + (assert-doctest (values 1 0) ">> (format t \"foo\") -> \"foo\" t" + :expected-output "[1] (FORMAT T foo) returned NIL, expected T.") + ;; Fails output, ok result + (assert-doctest (values 1 0) ">> (format t \"foo\") -> \"bar\" nil" + :expected-output "[1] (FORMAT T foo) printed \"foo\", expected \"bar\".") + ;; Fails output, fail result + (assert-doctest (values 1 0) ">> (format t \"foo\") -> \"bar\" t" + :expected-output "[1] (FORMAT T foo) printed \"foo\", expected \"bar\".") + ;; Output can test using symbols + (assert-doctest (values 0 1) ">> (format t \"foo\") -> |foo| nil") + ;; Output is enumerated + (assert-doctest (values 2 1) ">> t nil >> t t >> nil t" + :expected-output "[1] T returned T, expected NIL. +[3] NIL returned NIL, expected T.") + ;; Test variable + (defparameter test-variable :variable) + (setf (documentation 'test-variable 'variable) ">> sijo-doctest/tests::test-variable :variable") + (assert-doctest (values 0 1) 'test-variable) + ;; Test function + (defun test-function () :function) + (setf (documentation 'test-function 'function) ">> (sijo-doctest/tests::test-function) :function") + (assert-doctest (values 0 1) 'test-function) + ;; Test macro + ;; The following fails on ccl. Maybe a bug in ccl? + #-ccl + (progn + (defmacro test-macro () :macro) + (setf (documentation 'test-macro 'function) ">> (sijo-doctest/tests::test-macro) :macro") + (assert-doctest (values 0 1) 'test-macro)))