all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* Running ert tests on buffers in rst.el and elsewhere
@ 2012-06-18 21:20 Stefan Merten
  2012-06-19 18:06 ` Stefan Monnier
  2012-06-22 22:37 ` Christian Ohler
  0 siblings, 2 replies; 5+ messages in thread
From: Stefan Merten @ 2012-06-18 21:20 UTC (permalink / raw)
  To: emacs-devel; +Cc: Christian Ohler


[-- 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 --]

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: Running ert tests on buffers in rst.el and elsewhere
  2012-06-18 21:20 Running ert tests on buffers in rst.el and elsewhere Stefan Merten
@ 2012-06-19 18:06 ` Stefan Monnier
  2012-06-25  9:20   ` Stefan Merten
  2012-06-22 22:37 ` Christian Ohler
  1 sibling, 1 reply; 5+ messages in thread
From: Stefan Monnier @ 2012-06-19 18:06 UTC (permalink / raw)
  To: Stefan Merten; +Cc: Christian Ohler, emacs-devel

> 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.

Sounds OK.  The code looks mostly OK, except:
- It should either use (require 'cl-lib) or (eval-when-compile (require 'cl)).
- You can use the "--" convention for internal functions/variables
  (e.g. use ert--equal-buffer instead of ert-equal-buffer-internal).
- ert-Buf-create-string could probably use car-less-than-car if a speed
  boost is needed (probably not worth the trouble, tho).
- the docstrings talk about "run list FOO" which is meaningless to me
  (a list can't be run).  So describe FUNCALL a bit better (e.g. making
  it clear that it's expected to have the shape (FUN . ARGS)).
  BTW, instead of (apply (car funcall) (cdr funcall)) you can do
  (apply #'funcall funcall) or
  even (apply #'funcall #'funcall #'funcall funcall) for extra fun.
  Ideally, tho you should be able to just do (apply funcall).
  If interested, the patch below fixes `apply' to accept this use.


        Stefan


=== modified file 'src/eval.c'
--- src/eval.c	2012-06-09 03:14:44 +0000
+++ src/eval.c	2012-06-19 18:02:07 +0000
@@ -2202,7 +2202,7 @@
   return val;
 }
 \f
-DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
+DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
        doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
 Then return the value FUNCTION returns.
 Thus, (apply '+ 1 2 '(3 4)) returns 10.
@@ -2213,11 +2213,10 @@
   EMACS_INT numargs;
   register Lisp_Object spread_arg;
   register Lisp_Object *funcall_args;
-  Lisp_Object fun, retval;
+  Lisp_Object retval;
   struct gcpro gcpro1;
   USE_SAFE_ALLOCA;
 
-  fun = args [0];
   funcall_args = 0;
   spread_arg = args [nargs - 1];
   CHECK_LIST (spread_arg);
@@ -2232,43 +2231,14 @@
       return Ffuncall (nargs, args);
     }
 
-  numargs += nargs - 2;
+  numargs += nargs - 1;
 
-  /* Optimize for no indirection.  */
-  if (SYMBOLP (fun) && !EQ (fun, Qunbound)
-      && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
-    fun = indirect_function (fun);
-  if (EQ (fun, Qunbound))
-    {
-      /* Let funcall get the error.  */
-      fun = args[0];
-      goto funcall;
-    }
-
-  if (SUBRP (fun))
-    {
-      if (numargs < XSUBR (fun)->min_args
-	  || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
-	goto funcall;		/* Let funcall get the error.  */
-      else if (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args > numargs)
-	{
-	  /* Avoid making funcall cons up a yet another new vector of arguments
-	     by explicitly supplying nil's for optional values.  */
-	  SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
-	  for (i = numargs; i < XSUBR (fun)->max_args;)
-	    funcall_args[++i] = Qnil;
-	  GCPRO1 (*funcall_args);
-	  gcpro1.nvars = 1 + XSUBR (fun)->max_args;
-	}
-    }
- funcall:
-  /* We add 1 to numargs because funcall_args includes the
-     function itself as well as its arguments.  */
+  /* `numargs' includes the function itself as well as its arguments.  */
   if (!funcall_args)
     {
-      SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
+      SAFE_ALLOCA_LISP (funcall_args, numargs);
       GCPRO1 (*funcall_args);
-      gcpro1.nvars = 1 + numargs;
+      gcpro1.nvars = numargs;
     }
 
   memcpy (funcall_args, args, nargs * sizeof (Lisp_Object));




^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: Running ert tests on buffers in rst.el and elsewhere
  2012-06-18 21:20 Running ert tests on buffers in rst.el and elsewhere Stefan Merten
  2012-06-19 18:06 ` Stefan Monnier
@ 2012-06-22 22:37 ` Christian Ohler
  2012-06-25 10:06   ` Stefan Merten
  1 sibling, 1 reply; 5+ messages in thread
From: Christian Ohler @ 2012-06-22 22:37 UTC (permalink / raw)
  To: Stefan Merten; +Cc: emacs-devel

Stefan Merten, 2012-06-18:

> 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 only glanced at your code so far, but please do take a look at the 
current version of ERT, in particular the utility functions in ert-x.el 
and the way ert-x-tests.el uses them.

Some preliminary notes:

Is it true that your code covers two features, one about turning buffer 
content, point and mark into a data structure and back as well as 
comparing such data structures, the other about providing input to 
interactive functions like completing-read?

The function `ert-run-test-with-buffer' combines both features, and I 
don't think that's a good thing; it would be better to have a more 
primitive function `ert-run-with-interactive-inputs' (or similar) that 
doesn't do any of the buffer management, and let the programmer combine 
that function with `ert-with-test-buffer' and `ert-Buf-to-buffer' as 
appropriate.

Similarly, `ert-compare-test-with-buffer' looks like it checks a bunch 
of things that should probably be left as separate `should' forms on the 
caller's side.

With functions like `ert-equal-buffer', your code introduces a notion of 
equality of buffers, and its definition seems somewhat arbitrary, so I'm 
not sure it's a good one.  For example, it doesn't take buffer-local 
variables or markers into account.  It should be easy to avoid the 
question of what the right notion of buffer equality is by letting the 
programmer extract ert-Buf data structures from buffers and compare 
those in `should' forms with some equality predicate.

However, compared to the existing approach as used in the tests 
`ert-test-run-tests-interactively-2' and `ert-test-describe-test', your 
buffer handling functions add the ability to test the position of point 
and mark, while sacrificing the ability to test text properties (and 
thus font locking).  From a high-level perspective, testing point and 
mark looks like a small feature on top of testing buffer content, so I'm 
not sure it justifies as much additional machinery as your code seems to 
add; we should look for ways to simplify things.

As a first step, could make the two features (providing interactive 
input and handling buffer content) orthogonal and send separate patches, 
perhaps simplifying the buffer content code after looking at how it's 
done in ert-x-tests.el?


> 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.

ert-x.el does have features related to this, see 
`ert-propertized-string' and `ert-equal-including-properties'.  ERT's 
self-tests make use of them.

Christian.




^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: Running ert tests on buffers in rst.el and elsewhere
  2012-06-19 18:06 ` Stefan Monnier
@ 2012-06-25  9:20   ` Stefan Merten
  0 siblings, 0 replies; 5+ messages in thread
From: Stefan Merten @ 2012-06-25  9:20 UTC (permalink / raw)
  To: emacs-devel; +Cc: Christian Ohler


[-- Attachment #1.1: Type: text/plain, Size: 1611 bytes --]

Hi StefanMo, Christian, all!

6 days ago Stefan Monnier wrote:
>> 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.
> 
> Sounds OK.  The code looks mostly OK, except:
> - It should either use (require 'cl-lib) or (eval-when-compile (require 'cl)).

Done.

> - You can use the "--" convention for internal functions/variables
>   (e.g. use ert--equal-buffer instead of ert-equal-buffer-internal).

Done.

> - ert-Buf-create-string could probably use car-less-than-car if a speed
>   boost is needed (probably not worth the trouble, tho).

Indeed not worth the trouble.

> - the docstrings talk about "run list FOO" which is meaningless to me
>   (a list can't be run).  So describe FUNCALL a bit better (e.g. making
>   it clear that it's expected to have the shape (FUN . ARGS)).

I improved the whole documentation including a commentary section
describing how to use it.

I also revamped and refactored a few other things and added more
tests.

Most important changes are that `ert-equal-buffer' /
`ert-equal-buffer-return' are now macros so the form given as argument
needs not be quoted. Also these macros accept more parameters
including an option to say "the expected buffer should be the same as
the input buffer".

I include the code below.


						Grüße

						Stefan


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: Implementation --]
[-- Type: text/x-lisp, Size: 15764 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 point and mark as input and may modify all of them.  In addition
;; they may return some result.  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 to represent point or mark, respectively.
;;
;; Examples:
;;
;;   (should (ert-equal-buffer (insert "foo")
;;                             ; Insertion of "foo"...
;;   			       (concat ert-Buf-point-char ert-Buf-mark-char)
;;                             ; ...into an empty buffer with point and mark...
;;   			       (concat ert-Buf-mark-char "foo"
;;   				       ert-Buf-point-char)))
;;                             ; ...should result in a buffer containing "foo"
;;                             ; with point and mark moved appropriately.
;;
;;   (should (ert-equal-buffer (delete-region)
;;                             ; Deleting region...
;;                             `(,ert-Buf-mark-char "foo" ,ert-Buf-point-char)
;;                             ; ...in a region spanning the whole buffer...
;;                             (concat ert-Buf-point-char ert-Buf-mark-char)
;;                             ; ...should result in an empty buffer...
;;                             t))
;;                             ; ...when called interactively.
;;
;;   (should (ert-equal-buffer-return (point)
;;                                    ; Returning the point...
;;                                    ert-Buf-point-char
;;                                    ; ...in an empty buffer...
;;                                    t
;;                                    ; ...without changing the result buffer...
;;                                    1))
;;                                    ; ...should return 1.

;;; Code:

(eval-when-compile
  (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 nil) ; No default constructor.
	    (:constructor ert-Buf-from-string
			  (string
			   &aux
			   (analysis (ert-Buf--parse-string string))
			   (content (car analysis))
			   (point (cadr analysis))
			   (mark (caddr analysis))))
	    (:constructor ert-Buf-from-buffer
			  (&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.
`ert-Buf-from-string' constructs a structure from a given STRING.
`ert-Buf-from-buffer' constructs a structure from the current
buffer."
  (content nil :read-only t) ; Pure string content without any special markup.
  (point nil :read-only t) ; Position of point.
  (mark nil :read-only t) ; Position of mark.
  (string nil :read-only t) ; String representation.
  )

(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))))

(defun ert-Buf--from-argument (arg other)
  "Interpret ARG as input for an `ert-Buf', convert it and return the `ert-Buf'.
ARG may be one of the types described in
`ert-equal-buffer-return' or nil which is also returned."
  (cond
   ((not arg)
    nil)
   ((eq arg t)
    (when (or (not other) (eq other t))
      (error "First argument to `ert-Buf--from-argument' t requires a non-nil, non-t second argument"))
    (ert-Buf--from-argument other nil))
   ((characterp arg)
    (ert-Buf-from-string (char-to-string arg)))
   ((stringp arg)
    (ert-Buf-from-string arg))
   ((ert-Buf-p arg)
    arg)
   ((listp arg)
    (ert-Buf-from-string (apply 'concat arg)))
   (t
    (error "Unknown type for `ert-Buf--from-argument'"))))

;; ****************************************************************************
;; 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 (buf form interactive)
  "With a buffer filled with `ert-Buf' BUF evaluate function form FORM.
Return a cons consisting of the return value and a `ert-Buf'.  If
INTERACTIVE is non-nil FORM is evaluated in an interactive
environment."
  (with-temp-buffer
    (ert-Buf--to-buffer buf)
    (let ((act-return
	   (cond
	    ((not interactive)
	     (apply (car form) (cdr form)))
	    ((eq interactive t)
	     (let ((current-prefix-arg (cadr form)))
	       (call-interactively (car form))))
	    ((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 form)))
		   (call-interactively (car form)))
	       (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 (ert-Buf-from-buffer)))
      (cons act-return act-buf))))

(defun ert--compare-test-with-buffer (result buf ignore-return exp-return)
  "Compare RESULT of test with expected buffer BUF.
RESULT is a return value from `ert--run-test-with-buffer'.
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

IGNORE-RETURN, EXP-RETURN are described in `ert--equal-buffer'."
  (let ((act-return (car result))
	(act-buf (cdr result)))
    (list
     (or (not buf)
	 (equal (ert-Buf-content act-buf) (ert-Buf-content buf)))
     (or
      (not buf)
      (not (ert-Buf-point buf))
      (equal (ert-Buf-point act-buf) (ert-Buf-point buf)))
     (or ignore-return
	 (equal act-return exp-return)))))

(defun ert--equal-buffer (form input exp-output ignore-return exp-return interactive)
  "Run tests for `ert-equal-buffer-return' and `ert-equal-buffer'.
FORM, INPUT and EXP-OUTPUT are as described for
`ert-equal-buffer-return'.  Ignore return value if IGNORE-RETURN
or compare the return value to EXP-RETURN.  INTERACTIVE is as
described for `ert-equal-buffer-return'.  Return t if equal."
  (catch 'return
    (dolist (elem (ert--compare-test-with-buffer
		   (ert--run-test-with-buffer
		    (ert-Buf--from-argument input exp-output) form interactive)
		   (ert-Buf--from-argument exp-output input)
		   ignore-return exp-return) t)
      (unless elem
	(throw 'return nil)))))

(defmacro ert-equal-buffer-return (form input exp-output exp-return &optional interactive)
  "Evaluate function form FORM with a buffer and compare results.
Since `ert-equal-buffer-return' is a macro FORM is not evaluated
immediately. Thus you must give FORM as a normal function form
with no additional quoting.

The buffer is filled with INPUT.  Compare the buffer content to
EXP-OUTPUT if this is non-nil.  Compare the return value to
EXP-RETURN.  Return t if buffer and return value are equal to the
expected values.

INPUT and EXP-OUTPUT represent the input buffer or the expected
output buffer, respectively. They can be one of the following:

* nil in which case the respective buffer is not used. Makes
  sense only for EXP-OUTPUT.
* t in which case the other buffer is used unchanged. The other
  buffer must not be nil or t in this case.
* A character which is converted to a one character string.
* A string.
* A list of strings which are concatenated using `concat'. This
  can be used to shorten the form describing the buffer when used
  with quote or backquote.
* An `ert-Buf' object.

All input variants which end up in a string are parsed by
`ert-Buf-from-string'.

If INTERACTIVE is nil FORM is evaluated with no special context.
If INTERACTIVE is non-nil FORM is evaluated interactively and
`current-prefix-arg' is set to the cadr of FORM (i.e\. the first
argument in FORM) and thus must comply to the format of
`current-prefix-arg'.  If INTERACTIVE is t `call-interactively'
is used normally.  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.  This allows
simulating interactive user input.

Return t if buffer and return value equal the expected values."
  `(let ((formq ',form))
     (ert--equal-buffer formq ,input ,exp-output nil ,exp-return ,interactive)))

(defmacro ert-equal-buffer (form input exp-output &optional interactive)
  "Like `ert-equal-buffer-return' but the return value of FORM is ignored.
INPUT, EXP-OUTPUT and INTERACTIVE are described in
`ert-equal-buffer-return'."
  `(let ((formq ',form))
     (ert--equal-buffer formq ,input ,exp-output t nil ,interactive)))

;; ****************************************************************************
;; Explainers

(defun ert--equal-buffer-explain (form input exp-output ignore-return exp-return interactive)
  "Explain why `ert--equal-buffer' failed with these parameters.
Return the explanation.  FORM, INPUT, EXP-OUTPUT,
IGNORE-RETURN, EXP-RETURN, INTERACTIVE are described in
`ert--equal-buffer'."
  (let ((test-result (ert--run-test-with-buffer
		      (ert-Buf--from-argument input exp-output)
		      form interactive))
	(exp-buf (ert-Buf--from-argument exp-output input)))
    (destructuring-bind (ok-string ok-point ok-return)
	(ert--compare-test-with-buffer
	 test-result
	 (ert-Buf--from-argument exp-output input) 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 (form input exp-output exp-return &optional interactive)
  "Explain why `ert-equal-buffer-return' failed with these parameters.
Return the explanation.  FORM, INPUT, EXP-OUTPUT, EXP-RETURN,
INTERACTIVE are described in `ert--equal-buffer'."
  (ert--equal-buffer-explain
   form input exp-output nil exp-return interactive))

(put 'ert-equal-buffer-return 'ert-explainer 'ert-equal-buffer-return-explain)

(defun ert-equal-buffer-explain (form input exp-output &optional interactive)
  "Explain why `ert-equal-buffer' failed with these parameters.
Return the explanation.  FORM, INPUT, EXP-OUTPUT, EXP-RETURN,
INTERACTIVE are described in `ert--equal-buffer'."
  (ert--equal-buffer-explain
   form input exp-output t nil interactive))

(put 'ert-equal-buffer 'ert-explainer 'ert-equal-buffer-explain)

; LocalWords:  foo minibuffer

;; 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: Tests --]
[-- Type: text/x-lisp, Size: 6772 bytes --]

;;; buffer.el --- Test the test support for buffers


(add-to-list 'load-path ".")
(load "ert-buffer" nil t)

;; ****************************************************************************
;; `ert-Buf'

(defun roundtrip-ert-Buf (in)
  (with-temp-buffer
    (ert-Buf--to-buffer (ert-Buf-from-string in))
    (ert-Buf-string (ert-Buf-from-buffer))))

(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 (ert-Buf-from-string
		 (concat "ab" ert-Buf-point-char ert-Buf-point-char "c\n")))
  (should-error (ert-Buf-from-string
		 (concat "ab" ert-Buf-mark-char ert-Buf-mark-char "c\n")))
  )

(ert-deftest ert-Buf--from-argument ()
  "Test `ert-Buf--from-argument'."
  (let ((marked-a (ert-Buf-from-string
		   (concat ert-Buf-point-char "a" ert-Buf-mark-char))))
    (should (not (ert-Buf--from-argument nil nil)))
    (should (equal (ert-Buf--from-argument ?a nil)
		   (ert-Buf-from-string "a")))
    (should (equal (ert-Buf--from-argument ert-Buf-point-char nil)
		   (ert-Buf-from-string ert-Buf-point-char)))
    (should (equal (ert-Buf--from-argument '("a" "b") nil)
		   (ert-Buf-from-string "ab")))
    (should (equal (ert-Buf--from-argument `("a" ,ert-Buf-point-char "b") nil)
		   (ert-Buf-from-string (concat "a" ert-Buf-point-char "b"))))
    (should (equal (ert-Buf--from-argument marked-a nil) marked-a))
    (should-error (ert-Buf--from-argument -1 nil))
    (should-error (ert-Buf--from-argument [0] nil))
    (should-error (ert-Buf--from-argument t nil))
    (should-error (ert-Buf--from-argument t t))
    (should (eq (ert-Buf--from-argument t marked-a) marked-a))
  ))

;; ****************************************************************************
;; Advice `ert-completing-read'

(defvar read-fun-args nil
  "Input for for functions reading the minibuffer.
Consists of a list of functions and their argument lists 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"))
  )

;; ****************************************************************************
;; Test main functions

(ert-deftest ert-equal-buffer ()
  "Tests for `ert-equal-buffer'."
  (should (ert-equal-buffer (insert "foo")
			    (concat ert-Buf-point-char ert-Buf-mark-char)
			    (concat ert-Buf-mark-char "foo"
				    ert-Buf-point-char)))
  (should (ert-equal-buffer (delete-region)
			    (concat ert-Buf-mark-char "foo"
				    ert-Buf-point-char)
			    (concat ert-Buf-point-char ert-Buf-mark-char)
			    t))
  (should (ert-equal-buffer (delete-region 1 4)
			    "foo"
			    ""))
  (should-error (ert-equal-buffer (delete-region 0 3)
			    (concat "foo")
			    "") :type 'args-out-of-range)
  (should (ert-equal-buffer (goto-char 4)
			    "foo"
			    (concat "foo" ert-Buf-point-char)))
  )

(ert-deftest ert-equal-buffer-return ()
  "Tests for `ert-equal-buffer-return'."
  (should (ert-equal-buffer-return (buffer-substring-no-properties 4 1)
				   "foo"
				   t
				   "foo"))
  (should (ert-equal-buffer-return (delete-and-extract-region 1 4)
				   "foo"
				   ""
				   "foo"))
  (should (ert-equal-buffer-return (point)
				   ert-Buf-point-char
				   t
				   1))
  (should (ert-equal-buffer-return (point)
				   (concat " " ert-Buf-point-char)
				   t
				   2))
  (should (ert-equal-buffer-return (region-beginning)
				   (concat ert-Buf-point-char " "
					   ert-Buf-mark-char)
				   t
				   1))
  (should (ert-equal-buffer-return (region-end)
				   (concat ert-Buf-mark-char " "
					   ert-Buf-point-char)
				   t
				   2))
  (should (ert-equal-buffer-return (following-char)
				   (concat ert-Buf-point-char "A")
				   t
				   ?A))
  (should (ert-equal-buffer-return (following-char)
				   (concat "A" ert-Buf-point-char)
				   t
				   0))
  )

[-- Attachment #2: Type: application/pgp-signature, Size: 307 bytes --]

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: Running ert tests on buffers in rst.el and elsewhere
  2012-06-22 22:37 ` Christian Ohler
@ 2012-06-25 10:06   ` Stefan Merten
  0 siblings, 0 replies; 5+ messages in thread
From: Stefan Merten @ 2012-06-25 10:06 UTC (permalink / raw)
  To: Christian Ohler; +Cc: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 5300 bytes --]

Hi Christian!

I read your mail just now.

2 days ago Christian Ohler wrote:
> Stefan Merten, 2012-06-18:
>> 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 only glanced at your code so far, but please do take a look at the
> current version of ERT, in particular the utility functions in
> ert-x.el and the way ert-x-tests.el uses them.

I just did. Well, I probably did not give enough documentation in the
first place to understand what ert-buffer.el should be good for: Give
the user an *easy* way to define input buffer and expected output
buffer for a test. That's what `ert-equal-buffer' and
`ert-equal-buffer-return' is for. Part of this is that the user can
give strings describing the buffer so you can write comprehensible
tests like

      (should (ert-equal-buffer (insert "foo") "\^@\^?" "\^?foo\^@"))

Once you understood that ?\^@ stands for point and ?\^? stands for
mark the meaning of the test is immediately clear. This supports the
idea that a test also serves as a documentation for the respective
function.

I find no support for this idea in ert-x.el but I may miss something.

> Some preliminary notes:
> 
> Is it true that your code covers two features, one about turning
> buffer content, point and mark into a data structure and back as well
> as comparing such data structures,

Yes - in a preliminary way though.

> the other about providing input to
> interactive functions like completing-read?

The idea is to give a *simple* framework to test function calls which
operate on buffers. This includes interactive function calls which may
request further input from the user. That is why I implemented the
advices to the reading functions.

> The function `ert-run-test-with-buffer' combines both features, and I
> don't think that's a good thing; it would be better to have a more
> primitive function `ert-run-with-interactive-inputs' (or similar) that
> doesn't do any of the buffer management, and let the programmer
> combine that function with `ert-with-test-buffer' and
> `ert-Buf-to-buffer' as appropriate.

It could be useful to separate this feature more clearly to make it
reusable in other situations. However, for testing interactive
functions on buffers - which to me seems a quite natural thing to do -
it should stay a feature of `ert-equal-buffer' /
`ert-equal-buffer-return'.

> Similarly, `ert-compare-test-with-buffer' looks like it checks a bunch
> of things that should probably be left as separate `should' forms on
> the caller's side.

Same as above.

> With functions like `ert-equal-buffer', your code introduces a notion
> of equality of buffers, and its definition seems somewhat arbitrary,
> so I'm not sure it's a good one.

True. It's just what I needed for my own tests. This is certainly an
aspect which deserves more work.

> For example, it doesn't take
> buffer-local variables or markers into account.

Yes. I already thought about this. As mentioned above one design goal
of ert-buffer.el was simplicity for the user. Thus the user needs a
simple syntax to write a buffer contents for a test. I used ?\^@ and
?\^? as simple syntax for point and mark which at the same time should
not collide with real input.

What could an extension to this syntax including markers and text
properties look like? For text properties I thought of something like
?\^[ and ?\^] as delimiters and some content describing the properties
between the delimiters. May be plain lisp forms?

> It should be easy to
> avoid the question of what the right notion of buffer equality is by
> letting the programmer extract ert-Buf data structures from buffers
> and compare those in `should' forms with some equality predicate.

I agree that the programmer should have a chance to define her own
equality but there should be a reasonable default.

> From a high-level perspective, testing point
> and mark looks like a small feature on top of testing buffer content,
> so I'm not sure it justifies as much additional machinery as your code
> seems to add;

Not if you test a function like `insert' which has a clear contract on
how point and mark is treated. I guess this applies to the majority of
functions which operate on buffers.

> we should look for ways to simplify things.

Indeed. However, my notion of simplicity seems to differ from yours.

> As a first step, could make the two features (providing interactive
> input and handling buffer content) orthogonal and send separate
> patches, perhaps simplifying the buffer content code after looking at
> how it's done in ert-x-tests.el?

I will give it a try.

>> 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.
> 
> ert-x.el does have features related to this, see
> `ert-propertized-string' and `ert-equal-including-properties'.  ERT's
> self-tests make use of them.

I'll look at it.


						Grüße

						Stefan

[-- Attachment #2: Type: application/pgp-signature, Size: 307 bytes --]

^ permalink raw reply	[flat|nested] 5+ messages in thread

end of thread, other threads:[~2012-06-25 10:06 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-06-18 21:20 Running ert tests on buffers in rst.el and elsewhere Stefan Merten
2012-06-19 18:06 ` Stefan Monnier
2012-06-25  9:20   ` Stefan Merten
2012-06-22 22:37 ` Christian Ohler
2012-06-25 10:06   ` Stefan Merten

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.