From: Stefan Merten <smerten@oekonux.de>
To: emacs-devel@gnu.org
Cc: Christian Ohler <ohler@gnu.org>
Subject: Running ert tests on buffers in rst.el and elsewhere
Date: Mon, 18 Jun 2012 23:20:12 +0200 [thread overview]
Message-ID: <6280.1340054412@theowa.merten-home.homelinux.org> (raw)
[-- Attachment #1.1: Type: text/plain, Size: 1065 bytes --]
Hi!
During development of `rst.el` at some point I looked for some unit
test support and found the wonderful ert package which meanwhile is
part of Emacs.
I wanted to test functions which operate on buffers - i.e. use buffer
content as input and possibly modify the buffer. Buffer includes point
and mark in this case. Since I found no support for this requirement
in the ert package I wrote some support code for it. I just polished
it a bit to better fit into Emacs standards.
Since this is a problem others certainly share with me I happily
contribute `ert-buffer.el` containing the main routines and
`buffer.el` containing some tests for the former.
BTW: I installed ert on 2010-10-30 and so far did not use the version
in the Emacs source tree. I.e.: The code may not run smoothly with
current version due to version differences.
The next step I considered was to support testing font locking - or
may be text properties in general. However, I didn't start this yet.
It certainly would be useful.
Grüße
Stefan
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: ert-buffer.el --]
[-- Type: text/x-lisp, Size: 11873 bytes --]
;;; ert-buffer.el --- Support functions for running ert tests on buffers
;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Stefan Merten <smerten@oekonux.de>,
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Some functions need a buffer to run on. They may use the buffer content as
;; well as the point and the mark as input and may modify all of them. Here are
;; some support functions to test such functions using `ert'.
;;
;; Use `ert-equal-buffer' and/or `ert-equal-buffer-return' for your `should'
;; forms.
;;
;; You may use the constants `ert-Buf-point-char' and `ert-Buf-mark-char' in
;; constructing comparison strings.
;;; Code:
(require 'cl)
(require 'ert)
;; ****************************************************************************
;; `ert-Buf' and related functions
(defconst ert-Buf-point-char "\^@"
"Special character used to mark the position of point in a `ert-Buf'.")
(defconst ert-Buf-mark-char "\^?"
"Special character used to mark the position of mark in a `ert-Buf'.")
(defstruct (ert-Buf
(:constructor string-to-ert-Buf
(string
&aux
(analysis (ert-Buf-parse-string string))
(content (car analysis))
(point (cadr analysis))
(mark (caddr analysis))))
(:constructor buffer-to-ert-Buf
(&aux
(content (buffer-substring-no-properties
(point-min) (point-max)))
(point (point))
(mark (mark t))
(string
(ert-Buf-create-string content point mark)))))
"Structure to hold comparable information about a buffer."
(content nil :read-only t)
(point nil :read-only t)
(mark nil :read-only t)
(string nil :read-only t)
)
(defun ert-Buf-parse-string (string)
"Parse STRING and return clean results.
Return a list consisting of the cleaned content, the position of
point if `ert-Buf-point-char' was found and the the position of mark
if `ert-Buf-mark-char' was found."
(with-temp-buffer
(let ((case-fold-search nil)
fnd point-fnd mark-fnd)
(insert string)
(goto-char (point-min))
(while (re-search-forward
(concat "[" ert-Buf-point-char ert-Buf-mark-char "]") nil t)
(setq fnd (match-string 0))
(replace-match "")
(cond
((equal fnd ert-Buf-point-char)
(if point-fnd
(error "Duplicate point"))
(setq point-fnd (point)))
((equal fnd ert-Buf-mark-char)
(if mark-fnd
(error "Duplicate mark"))
(setq mark-fnd (point)))
(t
(error "Unexpected marker found"))))
(list (buffer-substring-no-properties (point-min) (point-max))
point-fnd mark-fnd))))
(defun ert-Buf-create-string (content point mark)
"Create a string representation from CONTENT, POINT and MARK."
(with-temp-buffer
(insert content)
(let (pnt-chs)
(if point
(setq pnt-chs (nconc pnt-chs (list (cons point ert-Buf-point-char)))))
(if mark
(setq pnt-chs (nconc pnt-chs (list (cons mark ert-Buf-mark-char)))))
;; Sort pairs so the highest position is last.
(setq pnt-chs (sort pnt-chs (lambda (el1 el2) (> (car el1) (car el2)))))
(while pnt-chs
(goto-char (caar pnt-chs))
(insert (cdar pnt-chs))
(setq pnt-chs (cdr pnt-chs)))
(buffer-substring-no-properties (point-min) (point-max)))))
(defun ert-Buf-to-buffer (buf)
"Set current buffer according to BUF."
(insert (ert-Buf-content buf))
(if (ert-Buf-point buf)
(goto-char (ert-Buf-point buf)))
(if (ert-Buf-mark buf)
(set-mark (ert-Buf-mark buf))))
;; ****************************************************************************
;; Runners
(defvar ert-inputs nil
"Variable to hold the strings to give successively to `ert-completing-read'.")
(defadvice completing-read (around ert-completing-read first
(prompt collection &optional predicate
require-match initial-input hist
def inherit-input-method))
"Advice `completing-read' to accept input from `ert-inputs'."
(if (not ert-inputs)
(error "No more input strings in `ert-inputs'"))
(let* ((input (pop ert-inputs)))
(setq ad-return-value
(cond
((eq (try-completion input collection predicate) t) ;; Perfect match.
input)
((not require-match) ;; Non-matching input allowed.
input)
((and (equal input "")
(eq require-match t)) ;; Empty input and this is allowed.
input)
(t
(error
"Input '%s' is not allowed for `completing-read' expecting %s"
input collection))))))
(defadvice read-string (around ert-read-string first
(prompt &optional initial-input history
default-value inherit-input-method))
"Advice `read-string' to accept input from `ert-inputs'."
(if (not ert-inputs)
(error "No more input strings in `ert-inputs'"))
(let* ((input (pop ert-inputs)))
(setq ad-return-value
(if (and (equal input "") default-value)
default-value
input))))
(defadvice read-number (around ert-read-number first
(prompt &optional default))
"Advice `read-number' to accept input from `ert-inputs'."
(if (not ert-inputs)
(error "No more input strings in `ert-inputs'"))
(let* ((input (pop ert-inputs)))
(setq ad-return-value
(if (and (equal input "") default)
default
input))))
(defun ert-run-test-with-buffer (input funcall interactive)
"With a buffer filled with INPUT run list FUNCALL.
Return a cons consisting of the return value and a `ert-Buf'. If
INTERACTIVE is non-nil FUNCALL is called in an interactive
environment."
(let ((buf (string-to-ert-Buf input)))
(with-temp-buffer
(ert-Buf-to-buffer buf)
(let ((act-return
(cond
((not interactive)
(apply (car funcall) (cdr funcall)))
((eq interactive t)
(let ((current-prefix-arg (cadr funcall)))
(call-interactively (car funcall))))
((listp interactive)
(setq ert-inputs interactive)
(ad-activate 'read-string)
(ad-activate 'read-number)
(ad-activate 'completing-read)
(unwind-protect
(let ((current-prefix-arg (cadr funcall)))
(call-interactively (car funcall)))
(progn
(ad-deactivate 'completing-read)
(ad-deactivate 'read-number)
(ad-deactivate 'read-string)))
(if ert-inputs
(error "%d input strings left over"
(length ert-inputs))))))
(act-buf (buffer-to-ert-Buf)))
(cons act-return act-buf)))))
(defun ert-compare-test-with-buffer (result exp-output ignore-return exp-return)
"Compare RESULT of test from `ert-run-test-with-buffer' with expected values.
Return a list of booleans where t stands for a successful test of this kind:
* Content of output buffer
* Point in output buffer
* Return value
EXP-OUTPUT, IGNORE-RETURN, EXP-RETURN are described in
`ert-equal-buffer-internal'."
(let ((act-return (car result))
(act-buf (cdr result))
(exp-buf (and exp-output (string-to-ert-Buf exp-output))))
(list
(or (not exp-buf)
(equal (ert-Buf-content act-buf) (ert-Buf-content exp-buf)))
(or
(not exp-buf)
(not (ert-Buf-point exp-buf))
(equal (ert-Buf-point act-buf) (ert-Buf-point exp-buf)))
(or ignore-return
(equal act-return exp-return)))))
(defun ert-equal-buffer-internal (funcall input exp-output ignore-return exp-return interactive)
"Run list FUNCALL with a buffer filled with INPUT.
Compare the buffer content to EXP-OUTPUT if this is
non-nil. Ignore return value if IGNORE-RETURN or compare the
return value to EXP-RETURN. Return t if equal.
INPUT and EXP-OUTPUT are expected to be parsable by
`ert-Buf-parse-string'.
If INTERACTIVE is non-nil the FUNCALL is done interactively and
`current-prefix-arg' is set to the cadr of FUNCALL and thus must
comply to the format of `current-prefix-arg'. If INTERACTIVE is t
only `call-interactively' is used. If INTERACTIVE is a list of
strings the elements of the list are given to (advised forms of)
functions reading from the minibuffer as user input strings."
(reduce (lambda (l r) (and l r))
(ert-compare-test-with-buffer
(ert-run-test-with-buffer input funcall interactive)
exp-output ignore-return exp-return)))
(defun ert-equal-buffer-return (funcall input exp-output exp-return &optional interactive)
"Call `ert-equal-buffer-internal' caring for result of FUNCALL.
INPUT, EXP-OUTPUT, IGNORE-RETURN, EXP-RETURN, INTERACTIVE are
described in `ert-equal-buffer-internal'."
(ert-equal-buffer-internal
funcall input exp-output nil exp-return interactive))
(defun ert-equal-buffer (funcall input exp-output &optional interactive)
"Call `ert-equal-buffer-internal' not caring for result of FUNCALL.
INPUT, EXP-OUTPUT, INTERACTIVE are described in
`ert-equal-buffer-internal'."
(ert-equal-buffer-internal funcall input exp-output t nil interactive))
;; ****************************************************************************
;; Explainers
(defun ert-equal-buffer-internal-explain (funcall input exp-output ignore-return exp-return interactive)
"Explain why `ert-equal-buffer-internal' failed with these parameters.
Return the explanation. FUNCALL, INPUT, EXP-OUTPUT,
IGNORE-RETURN, EXP-RETURN, INTERACTIVE are described in
`ert-equal-buffer-internal'."
(let ((test-result (ert-run-test-with-buffer input funcall interactive))
(exp-buf (and exp-output (string-to-ert-Buf exp-output))))
(destructuring-bind (ok-string ok-point ok-return)
(ert-compare-test-with-buffer
test-result exp-output ignore-return exp-return)
(let (result)
(if (not ok-return)
(push (list 'different-return-values
(ert--explain-not-equal (car test-result) exp-return))
result))
(if (not ok-point)
(push (list 'different-points
(ert-Buf-string (cdr test-result))
(ert-Buf-string exp-buf))
result))
(if (not ok-string)
(push (list 'different-buffer-contents
(ert--explain-not-equal
(ert-Buf-content (cdr test-result))
(ert-Buf-content exp-buf)))
result))
result))))
(defun ert-equal-buffer-return-explain (funcall input exp-output exp-return &optional interactive)
"Explain why `ert-equal-buffer-return' failed with these parameters.
Return the explanation. FUNCALL, INPUT, EXP-OUTPUT, EXP-RETURN,
INTERACTIVE are described in `ert-equal-buffer-internal'."
(ert-equal-buffer-internal-explain
funcall input exp-output nil exp-return interactive))
(put 'ert-equal-buffer-return 'ert-explainer 'ert-equal-buffer-return-explain)
(defun ert-equal-buffer-explain (funcall input exp-output &optional interactive)
"Explain why `ert-equal-buffer' failed with these parameters.
Return the explanation. FUNCALL, INPUT, EXP-OUTPUT, EXP-RETURN,
INTERACTIVE are described in `ert-equal-buffer-internal'."
(ert-equal-buffer-internal-explain
funcall input exp-output t nil interactive))
(put 'ert-equal-buffer 'ert-explainer 'ert-equal-buffer-explain)
;; Local Variables:
;; sentence-end-double-space: t
;; End:
(provide 'ert-buffer)
;;; ert-buffer.el ends here
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: buffer.el --]
[-- Type: text/x-lisp, Size: 3989 bytes --]
;; Test the test support for buffers
(add-to-list 'load-path ".")
(load "ert-buffer" nil t)
(add-to-list 'load-path "..")
(load "rst.el" nil t)
;; ****************************************************************************
;; `ert-Buf'
(defun roundtrip-ert-Buf (in)
(with-temp-buffer
(ert-Buf-to-buffer (string-to-ert-Buf in))
(ert-Buf-string (buffer-to-ert-Buf))))
(ert-deftest ert-Buf ()
"Tests for functions working with `ert-Buf's"
(should (equal (concat ert-Buf-point-char "abc\n")
(roundtrip-ert-Buf (concat ert-Buf-point-char "abc\n"))))
(should (equal (concat "a" ert-Buf-point-char "bc\n")
(roundtrip-ert-Buf (concat "a" ert-Buf-point-char "bc\n"))))
(should (equal (concat "ab" ert-Buf-point-char "c\n")
(roundtrip-ert-Buf (concat "ab" ert-Buf-point-char "c\n"))))
(should (equal (concat "abc" ert-Buf-point-char "\n")
(roundtrip-ert-Buf (concat "abc" ert-Buf-point-char "\n"))))
(should (equal (concat "abc\n" ert-Buf-point-char)
(roundtrip-ert-Buf (concat "abc\n" ert-Buf-point-char))))
(should (equal (concat ert-Buf-point-char "abc\n" ert-Buf-mark-char "")
(roundtrip-ert-Buf
(concat ert-Buf-point-char "abc\n" ert-Buf-mark-char ""))))
(should (equal (concat ert-Buf-mark-char "abc\n" ert-Buf-point-char)
(roundtrip-ert-Buf
(concat ert-Buf-mark-char "abc\n" ert-Buf-point-char))))
(should (equal (concat "a" ert-Buf-mark-char ert-Buf-point-char "bc\n")
(roundtrip-ert-Buf
(concat "a" ert-Buf-point-char "" ert-Buf-mark-char "bc\n"))))
(should (equal (concat "ab" ert-Buf-mark-char "" ert-Buf-point-char "c\n")
(roundtrip-ert-Buf
(concat "ab" ert-Buf-mark-char ert-Buf-point-char "c\n"))))
(should-error (string-to-ert-Buf
(concat "ab" ert-Buf-point-char ert-Buf-point-char "c\n")))
(should-error (string-to-ert-Buf
(concat "ab" ert-Buf-mark-char ert-Buf-mark-char "c\n")))
)
;; ****************************************************************************
;; Advice `ert-completing-read'
(defvar read-fun-args nil
"A list of functions and their argument lists for functions
reading the minibuffer to be run successively. Prompt is omitted.")
(defun insert-reads ()
(interactive)
(while read-fun-args
(let* ((fun-arg (pop read-fun-args))
(result (apply (car fun-arg) "" (cdr fun-arg))))
(insert (if (integerp result)
(int-to-string result)
result) "\n"))))
(defun test-reads (inputs fun-args result)
(setq read-fun-args fun-args)
(ert-equal-buffer '(insert-reads) "" result inputs))
(ert-deftest reads ()
"Tests for functions using `completing-read's"
(should (test-reads '(5) '((read-number)) "5\n"))
(should (test-reads nil nil ""))
(should-error (test-reads '("") nil "")) ;; Too much input
(should-error (test-reads '(5) '((read-number)
(read-number)) "")) ;; Too less input
(should (test-reads '("") '((completing-read nil)) "\n"))
(should (test-reads '("" "") '((completing-read nil)
(completing-read nil)) "\n\n"))
(should (test-reads '("a" "b") '((completing-read nil)
(completing-read nil)) "a\nb\n"))
(should (test-reads '("a" "b") '((completing-read ("a" "b"))
(completing-read ("a" "b"))) "a\nb\n"))
(should (test-reads '("a" "b") '((completing-read ("a" "b"))
(completing-read ("a"))) "a\nb\n"))
(should-error (test-reads '("a" "b")
'((completing-read ("a" "b"))
(completing-read ("a") nil t)) "a\nb\n")) ;; Invalid input
(should (test-reads '("a" "")
'((completing-read ("a" "b"))
(completing-read ("a") nil t)) "a\n\n"))
(should-error (test-reads '("a" "")
'((completing-read ("a" "b"))
(completing-read ("a") nil 'non-empty)) "a\n\n"))
(should (test-reads '("x") '((read-string)) "x\n"))
(should (test-reads '("") '((read-string nil nil "x")) "x\n"))
(should (test-reads '("y") '((read-string nil nil "x")) "y\n"))
(should (test-reads '("") '((read-number 5)) "5\n"))
(should (test-reads '(0) '((read-number 5)) "0\n"))
)
[-- Attachment #2: Type: application/pgp-signature, Size: 307 bytes --]
next reply other threads:[~2012-06-18 21:20 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2012-06-18 21:20 Stefan Merten [this message]
2012-06-19 18:06 ` Running ert tests on buffers in rst.el and elsewhere Stefan Monnier
2012-06-25 9:20 ` Stefan Merten
2012-06-22 22:37 ` Christian Ohler
2012-06-25 10:06 ` Stefan Merten
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=6280.1340054412@theowa.merten-home.homelinux.org \
--to=smerten@oekonux.de \
--cc=emacs-devel@gnu.org \
--cc=ohler@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.