From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Merten Newsgroups: gmane.emacs.devel Subject: Running ert tests on buffers in rst.el and elsewhere Date: Mon, 18 Jun 2012 23:20:12 +0200 Message-ID: <6280.1340054412@theowa.merten-home.homelinux.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" X-Trace: dough.gmane.org 1340054434 14740 80.91.229.3 (18 Jun 2012 21:20:34 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Mon, 18 Jun 2012 21:20:34 +0000 (UTC) Cc: Christian Ohler To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Jun 18 23:20:33 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1SgjN7-0003Sn-JN for ged-emacs-devel@m.gmane.org; Mon, 18 Jun 2012 23:20:29 +0200 Original-Received: from localhost ([::1]:37004 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SgjN7-0008Jp-B6 for ged-emacs-devel@m.gmane.org; Mon, 18 Jun 2012 17:20:29 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:47369) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SgjN3-0008Jk-4C for emacs-devel@gnu.org; Mon, 18 Jun 2012 17:20:27 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SgjMz-0004gf-9r for emacs-devel@gnu.org; Mon, 18 Jun 2012 17:20:24 -0400 Original-Received: from moutng.kundenserver.de ([212.227.17.9]:59741) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SgjMy-0004fV-RH; Mon, 18 Jun 2012 17:20:21 -0400 Original-Received: from theowa.merten-home.homelinux.org (ip-109-84-0-84.web.vodafone.de [109.84.0.84]) by mrelayeu.kundenserver.de (node=mreu3) with ESMTP (Nemesis) id 0M4P8q-1Ri8zt3xfQ-00yhyM; Mon, 18 Jun 2012 23:20:18 +0200 Original-Received: by theowa.merten-home.homelinux.org (Postfix, from userid 1000) id DBC37401D4; Mon, 18 Jun 2012 23:20:12 +0200 (CEST) Original-Received: from theowa.merten-home.homelinux.org (localhost [127.0.0.1]) by theowa.merten-home.homelinux.org (Postfix) with ESMTP id D8B337A007; Mon, 18 Jun 2012 23:20:12 +0200 (CEST) X-Mailer: MH-E 8.2; nmh 1.3; GNU Emacs 23.1.1 X-Provags-ID: V02:K0:SgK51XNgI0jjnUBkf0Y3aEwsxQZqThGV5MsWpJ1txtB kC2LF+At6RuQ6MbESRMrvSbmLfdyiZaOyEwAHJa2vhRbciPVRx qzcNSFKnEWtP6yKUCuPSZebzgqlKHsgpoRy3u+/KH5H0/9STnz tq8VphHvJ2praQ3tW281dAqIY4yiCWjCV9pcOU3vwEptcNcPgh gOgdc6CG/6kEghQbaBMIeVnt5Ir+UhphxXAcot7VmaGIcMIMWL bYTJibo32qNw+4OQTJtSnWBQyMD40/OSWFdsAr9YZU6cYw5UVk LOlCKHEko2jpAKTtp+jHn/MKr5QvdTQ/2uLDz/emHjpIbYfqGX e2IBDtaT7OjI43v/uWiBpc+pKYRQhWdqYFNGW0HQZIjhyyEv2P 9+CSFlnCMs+Vzj5MUKjeKtrN9/uXhkE0AE= X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 212.227.17.9 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:151001 Archived-At: --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: quoted-printable 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=FC=DFe Stefan --=-=-= Content-Type: text/x-lisp Content-Disposition: attachment; filename=ert-buffer.el Content-Transfer-Encoding: quoted-printable ;;; ert-buffer.el --- Support functions for running ert tests on buffers ;; Copyright (C) 2010-2012 Free Software Foundation, Inc. ;; Author: Stefan Merten , ;; 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 . ;;; Commentary: ;;=20 ;; 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. Her= e 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-rea= d'.") (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-re= turn) "Compare RESULT of test from `ert-run-test-with-buffer' with expected val= ues. 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 ex= p-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 &option= al 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-r= eturn 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-expla= in) (defun ert-equal-buffer-explain (funcall input exp-output &optional interac= tive) "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 --=-=-= Content-Type: text/x-lisp Content-Disposition: attachment; filename=buffer.el ;; 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")) ) --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQCVAwUBT9+biQnTZgC3zSk5AQLlgQP+L5x171v1SR2v/fahvqw6W5J0Cok1HI/G s9xH/ridunlc0bMOY0FpDGbeWKShwf00uQErG1pLCzxc90J/ogYo9AicT89JzqMl j+WVehVRGRow1MJzXYhSf/3LYly4sewb1ZcMXoEHAdYH2+JGjAnHBt6RwELULXZM /CCoTQfBUQA= =xPlT -----END PGP SIGNATURE----- --==-=-=--