doctest.el

;;; doctest.el --- Doctests for Emacs Lisp -*- lexical-binding: t -*-

;; Authors: Chris Rayner (dchrisrayner@gmail.com)
;; Created: Apr 8 2020
;; Keywords: lisp maint docs help
;; URL: https://github.com/riscy/doctest
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Package-Requires: ((emacs "24.3"))
;; Version: 0.0.0

;;; Commentary:

;; These are like a Python "doctest", but for Emacs Lisp and with an Emacs
;; twist.  A doctest is a test written inside a docstring.  They look like:
;;
;; >> (+ 1 1)
;; => 2
;;
;; Inline comments are fine, but quotation marks must be escaped:
;;
;; >> (concat nil \"Hello world\")  ; concat should ignore nils
;; => \"Hello world\"               ; ...and return a string
;;
;; Some benefits:
;; - It's a clean way to test elisp code without any heavy dependencies
;; - It encourages functions that are pure or at least side-effect-free
;; - Your unit tests turn into documentation that your users can read!
;;
;; Use ~M-x doctest~ to run doctests on an entire buffer.
;; Use ~M-x doctest-here~ to run the doctest on the current line.
;; Use ~M-x doctest-defun~ to run the current defun's doctests.

;;; Code:

(defvar doctest-input "^>> \\(.*\\)"
  "The prompt for doctest input.
>> (stringp doctest-input)
=> t")
(defvar doctest-output "=> "
  "The regexp for doctest output.
>> (string-suffix-p \" \" doctest-output)
=> t")

(defvar doctest--first-failure nil "Point of first failure, or nil.")
(defvar doctest--text nil "Eventual report to show the user.")
(defvar doctest--fail 0 "Number of tests that have failed.")
(defvar doctest--pass 0 "Number of tests that have passed.")

(defun doctest (&optional filename)
  "Run doctest on current buffer, or FILENAME if given.
When run interactively, the point will move to the site of the
first test failure (or the first syntax error in a test).

Examples of tests that pass:
>> (cons (list 6 'quoted :symbol 12345 \"A string\") (+ 0 8310247))
=> ((6 quoted :symbol 12345 \"A string\") . 8310247)
>> (list ?A 1 2 3 (1+ 3))
=> (65 1 2 3 4)
>> 6
=> 6

This function sends its report using `send-string-to-terminal' if
`noninteractive' is non-nil, otherwise it simply uses `message'."
  (interactive)
  (when filename (set-buffer (find-file filename)))
  (doctest--reset-state)
  (save-excursion
    (goto-char (point-min))
    (while (ignore-errors (goto-char (doctest--next-test)))
      (doctest-here)))
  (let ((tally (format "%s passed, %s failed" doctest--pass doctest--fail)))
    (cond
     (doctest--first-failure
      (goto-char doctest--first-failure)
      (doctest--message (format "%s\n%s" tally doctest--text)))
     (t (doctest--message tally)))))

(defun doctest-here (&optional interactively)
  "Run the test that the point is currently on.
If called INTERACTIVELY, let the user know the test passed and
move the point down two lines (possibly onto the next test).
Internally, the doctest input line is evaluated with `eval' and
normalized into its `princ' form, while the output line is
normalized into its `princ' form without being evaluated."
  (interactive "p")
  (beginning-of-line)
  (cond
   ((looking-at doctest-input)
    (let* ((input (doctest-unescape (match-string-no-properties 1)))
           (evaluated-input
            (format "%S" (eval (car (read-from-string input)))))
           (output (and (forward-line 1) (doctest--target-output)))
           (output (format "%S" (car (read-from-string output)))))
      (if interactively
          (doctest--here-interactively input evaluated-input output)
        (doctest--here-noninteractively input evaluated-input output))))
   (t (message "No doctest here."))))

(defun doctest-defun ()
  "Run `doctest' on the current defun.
This defun is the one that contains point or follows point,
determined by calling `narrow-to-defun'."
  (interactive)
  (save-restriction (narrow-to-defun) (eval-buffer) (doctest)))

(defun doctest--message (str)
  "Display STR or send string to terminal if `noninteractive'.
`message' expects format strings and has to be accommodated;
`send-string-to-terminal' has a newline added to the end."
  (if (not noninteractive)
      (message "%s" str)
    (send-string-to-terminal (concat str "\n"))))

(defun doctest--target-output ()
  "Read and return the target output on the current line.
This is a line beginning with `doctest-output'."
  (when (looking-at doctest-output)
    (end-of-line)
    (while (not
            (or (nth 3 (syntax-ppss)) (bolp)))
      (backward-char 1)) ; back up into the string
    (doctest-unescape
     (buffer-substring
      (+ (point-at-bol) (length doctest-output))
      (point)))))

(defun doctest--here-interactively (sexp actual-value target-value)
  "Compare ACTUAL-VALUE (generated by SEXP) to TARGET-VALUE.
Let the user know the test passed and move to the next line."
  (cond
   ((not (string= actual-value target-value))
    (message "%s => %s but got %s" sexp target-value actual-value))
   (t (forward-line 1) (message "Pass!"))))

(defun doctest--here-noninteractively (sexp actual-value target-value)
  "Compare ACTUAL-VALUE (generated by SEXP) to TARGET-VALUE.
Call `doctest--append' to append to the running test output."
  (cond
   ((not (string= actual-value target-value))
    (setq doctest--fail (1+ doctest--fail))
    (setq doctest--first-failure (or doctest--first-failure (point)))
    (doctest--append
     (format "%s.el#%s: %s => %s but got %s"
             (file-name-base (buffer-file-name))
             (line-number-at-pos)
             sexp target-value actual-value)))
   (t (setq doctest--pass (1+ doctest--pass)))))

(defun doctest--reset-state ()
  "Reset doctest's current state."
  (when (eq major-mode 'emacs-lisp-mode) (eval-buffer))
  (setq doctest--text nil
        doctest--fail 0
        doctest--pass 0
        doctest--first-failure nil))

(defun doctest--next-test ()
  "Return the point where the next test begins -- else nil.
>> (eq (doctest--next-test) (point))
=> t"
  (declare (side-effect-free t))
  (let (doctest-point)
    (save-excursion
      (while (and (not doctest-point) (re-search-forward doctest-input nil t))
        (and
         (nth 3 (syntax-ppss))           ; in a string
         (zerop (forward-line 1))        ; ...with a next line
         (nth 3 (syntax-ppss))           ; ...also in a string
         (looking-at doctest-output)     ; ...with doctest output
         (zerop (forward-line -1))
         (setq doctest-point (point)))))
    doctest-point))

(defun doctest--append (str)
  "Append STR to `doctest-text' with a newline if necessary."
  (setq doctest--text (concat doctest--text (unless doctest--text "\n") str)))

(defun doctest-unescape (str)
  "Remove all backslashes from STR.
It's open work to parse/handle backslashes cleanly, so ignore them.
>> (doctest-unescape \"back\\\\slash\")
=> \"backslash\""
  (declare (side-effect-free t) (pure t))
  (replace-regexp-in-string "\\\\" "" str))

(provide 'doctest)
;;; doctest.el ends here