summaryrefslogtreecommitdiff
path: root/test/lisp/textmodes
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp/textmodes')
-rw-r--r--test/lisp/textmodes/css-mode-tests.el222
-rw-r--r--test/lisp/textmodes/reftex-tests.el223
-rw-r--r--test/lisp/textmodes/sgml-mode-tests.el135
-rw-r--r--test/lisp/textmodes/tildify-tests.el264
4 files changed, 844 insertions, 0 deletions
diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
new file mode 100644
index 00000000000..f92ac111142
--- /dev/null
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -0,0 +1,222 @@
+;;; css-mode-tests.el --- Test suite for CSS mode -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords: internal
+
+;; This file is part of GNU Emacs.
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'css-mode)
+(require 'ert)
+(require 'seq)
+
+(ert-deftest css-test-property-values ()
+ ;; The `float' property has a flat value list.
+ (should
+ (equal (seq-sort #'string-lessp (css--property-values "float"))
+ '("left" "none" "right")))
+
+ ;; The `list-style' property refers to several other properties.
+ (should
+ (equal (seq-sort #'string-lessp (css--property-values "list-style"))
+ (seq-sort
+ #'string-lessp
+ (seq-uniq
+ (append (css--property-values "list-style-type")
+ (css--property-values "list-style-position")
+ (css--property-values "list-style-image"))))))
+
+ ;; The `position' property is tricky because it's also the name of a
+ ;; value class.
+ (should
+ (equal (seq-sort #'string-lessp (css--property-values "position"))
+ '("absolute" "fixed" "relative" "static")))
+
+ ;; The `background-position' property should refer to the `position'
+ ;; value class, not the property of the same name.
+ (should
+ (equal (css--property-values "background-position")
+ (css--value-class-lookup 'position)))
+
+ ;; Check that the `color' property doesn't cause infinite recursion
+ ;; because it refers to the value class of the same name.
+ (should (= (length (css--property-values "color")) 147)))
+
+(ert-deftest css-test-property-value-cache ()
+ "Test that `css--property-value-cache' is in use."
+ (should-not (gethash "word-wrap" css--property-value-cache))
+ (let ((word-wrap-values (css--property-values "word-wrap")))
+ (should (equal (gethash "word-wrap" css--property-value-cache)
+ word-wrap-values))))
+
+(ert-deftest css-test-property-values-no-duplicates ()
+ "Test that `css--property-values' returns no duplicates."
+ ;; The `flex' property is prone to duplicate values; if they aren't
+ ;; removed, it'll contain at least two instances of `auto'.
+ (should
+ (equal (seq-sort #'string-lessp (css--property-values "flex"))
+ '("auto" "calc()" "content" "none"))))
+
+(ert-deftest css-test-value-class-lookup ()
+ (should
+ (equal (seq-sort #'string-lessp (css--value-class-lookup 'position))
+ '("bottom" "calc()" "center" "left" "right" "top"))))
+
+;;; Completion
+
+(defun css-mode-tests--completions ()
+ (let ((data (css-completion-at-point)))
+ (all-completions (buffer-substring (nth 0 data) (nth 1 data))
+ (nth 2 data))))
+
+(ert-deftest css-test-complete-bang-rule ()
+ (with-temp-buffer
+ (css-mode)
+ (insert "body { left: 0 !")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "important" completions))
+ ;; Don't include SCSS bang-rules
+ (should-not (member "default" completions)))))
+
+(ert-deftest scss-test-complete-bang-rule ()
+ (with-temp-buffer
+ (scss-mode)
+ (insert "body { left: 0 !")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "important" completions))
+ (should (member "default" completions)))))
+
+(ert-deftest css-test-complete-property-value ()
+ (with-temp-buffer
+ (css-mode)
+ (insert "body { position: ")
+ (let ((completions (css-mode-tests--completions)))
+ (should
+ (equal (seq-sort #'string-lessp completions)
+ '("absolute" "fixed" "inherit" "initial" "relative"
+ "static" "unset"))))))
+
+(ert-deftest css-test-complete-pseudo-class ()
+ (with-temp-buffer
+ (css-mode)
+ (insert "body:a")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "active" completions))
+ (should-not (member "disabled" completions))
+ ;; Don't include pseudo-elements
+ (should-not (member "after" completions)))))
+
+(ert-deftest css-test-complete-pseudo-element ()
+ (with-temp-buffer
+ (css-mode)
+ (insert "body::a")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "after" completions))
+ (should-not (member "disabled" completions))
+ ;; Don't include pseudo-classes
+ (should-not (member "active" completions)))))
+
+(ert-deftest css-test-complete-at-rule ()
+ (with-temp-buffer
+ (css-mode)
+ (insert "@m")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "media" completions))
+ (should-not (member "keyframes" completions))
+ ;; Don't include SCSS at-rules
+ (should-not (member "mixin" completions)))))
+
+(ert-deftest scss-test-complete-at-rule ()
+ (with-temp-buffer
+ (scss-mode)
+ (insert "@m")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "media" completions))
+ (should-not (member "keyframes" completions))
+ (should (member "mixin" completions)))))
+
+(ert-deftest css-test-complete-property ()
+ (with-temp-buffer
+ (css-mode)
+ (insert "body { f")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "filter" completions))
+ (should-not (member "position" completions)))))
+
+(ert-deftest css-test-foreign-completions ()
+ (let ((other-buffer-1 (generate-new-buffer "1"))
+ (other-buffer-2 (generate-new-buffer "2")))
+ (with-current-buffer other-buffer-1
+ (setq-local css-class-list-function (lambda () '("foo" "bar"))))
+ (with-current-buffer other-buffer-2
+ (setq-local css-class-list-function (lambda () '("bar" "baz"))))
+ (let ((completions
+ (css--foreign-completions 'css-class-list-function)))
+ ;; Completions from `other-buffer-1' and `other-buffer-2' should
+ ;; be merged.
+ (should (equal (seq-sort #'string-lessp completions)
+ '("bar" "baz" "foo"))))
+ (kill-buffer other-buffer-1)
+ (kill-buffer other-buffer-2)))
+
+(ert-deftest css-test-complete-selector-tag ()
+ (with-temp-buffer
+ (css-mode)
+ (insert "b")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "body" completions))
+ (should-not (member "article" completions)))))
+
+(ert-deftest css-test-complete-selector-class ()
+ (with-temp-buffer
+ (setq-local css-class-list-function (lambda () '("foo" "bar")))
+ (with-temp-buffer
+ (css-mode)
+ (insert ".f")
+ (let ((completions (css-mode-tests--completions)))
+ (should (equal completions '("foo")))))))
+
+(ert-deftest css-test-complete-selector-id ()
+ (with-temp-buffer
+ (setq-local css-id-list-function (lambda () '("foo" "bar")))
+ (with-temp-buffer
+ (css-mode)
+ (insert "#b")
+ (let ((completions (css-mode-tests--completions)))
+ (should (equal completions '("bar")))))))
+
+(ert-deftest css-test-complete-nested-selector ()
+ (with-temp-buffer
+ (css-mode)
+ (insert "body {")
+ (let ((completions (css-mode-tests--completions)))
+ (should-not (member "body" completions)))))
+
+(ert-deftest scss-test-complete-nested-selector ()
+ (with-temp-buffer
+ (scss-mode)
+ (insert "body { b")
+ (let ((completions (css-mode-tests--completions)))
+ (should (member "body" completions))
+ (should-not (member "article" completions)))))
+
+(provide 'css-mode-tests)
+;;; css-mode-tests.el ends here
diff --git a/test/lisp/textmodes/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el
new file mode 100644
index 00000000000..12ec7f5a394
--- /dev/null
+++ b/test/lisp/textmodes/reftex-tests.el
@@ -0,0 +1,223 @@
+;;; reftex-tests.el --- Test suite for reftex. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
+
+;; Author: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+;; Keywords: internal
+;; Human-Keywords: internal
+
+;; 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/>.
+
+;;; Code:
+
+(require 'ert)
+
+;;; reftex
+(require 'reftex)
+
+;;; reftex-parse
+(require 'reftex-parse)
+
+(ert-deftest reftex-locate-bibliography-files ()
+ "Test `reftex-locate-bibliography-files'."
+ (let ((temp-dir (make-temp-file "reftex-bib" 'dir))
+ (files '("ref1.bib" "ref2.bib"))
+ (test '(("\\addbibresource{ref1.bib}\n" . ("ref1.bib"))
+ ("\\\\addbibresource[label=x]{ref2.bib}\\n" . ("ref2.bib"))
+ ("\\begin{document}\n\\bibliographystyle{plain}\n
+\\bibliography{ref1,ref2}\n\\end{document}" . ("ref1.bib" "ref2.bib"))))
+ (reftex-bibliography-commands
+ ;; Default value: See reftex-vars.el `reftex-bibliography-commands'
+ '("bibliography" "nobibliography" "setupbibtex\\[.*?database="
+ "addbibresource")))
+ (with-temp-buffer
+ (insert "test\n")
+ (mapc
+ (lambda (file)
+ (write-region (point-min) (point-max) (expand-file-name file
+ temp-dir)))
+ files))
+ (mapc
+ (lambda (data)
+ (with-temp-buffer
+ (insert (car data))
+ (let ((res (mapcar #'file-name-nondirectory
+ (reftex-locate-bibliography-files temp-dir))))
+ (should (equal res (cdr data))))))
+ test)
+ (delete-directory temp-dir 'recursive)))
+
+(ert-deftest reftex-what-environment-test ()
+ "Test `reftex-what-environment'."
+ (with-temp-buffer
+ (insert "\\begin{equation}\n x=y^2\n")
+ (let ((pt (point))
+ pt2)
+ (insert "\\end{equation}\n")
+ (goto-char pt)
+
+ (should (equal (reftex-what-environment 1) '("equation" . 1)))
+ (should (equal (reftex-what-environment t) '(("equation" . 1))))
+
+ (insert "\\begin{something}\nxxx")
+ (setq pt2 (point))
+ (insert "\\end{something}")
+ (goto-char pt2)
+ (should (equal (reftex-what-environment 1) `("something" . ,pt)))
+ (should (equal (reftex-what-environment t) `(("something" . ,pt)
+ ("equation" . 1))))
+ (should (equal (reftex-what-environment t pt) `(("something" . ,pt))))
+ (should (equal (reftex-what-environment '("equation"))
+ '("equation" . 1))))))
+
+(ert-deftest reftex-roman-number-test ()
+ "Test `reftex-roman-number'."
+ (let ((hindu-arabic '(1 2 4 9 14 1050))
+ (roman '("I" "II" "IV" "IX" "XIV" "ML")))
+ (while (and hindu-arabic roman)
+ (should (string= (reftex-roman-number (car hindu-arabic))
+ (car roman)))
+ (pop roman)
+ (pop hindu-arabic))))
+
+(ert-deftest reftex-parse-from-file-test ()
+ "Test `reftex-parse-from-file'."
+ ;; Use file-truename to convert 8+3 aliases in $TEMP value on
+ ;; MS-Windows into their long file-name equivalents, which is
+ ;; necessary for the 'equal' and 'string=' comparisons below. This
+ ;; also resolves any symlinks, which cannot be bad for the same
+ ;; reason. (An alternative solution would be to use file-equal-p,
+ ;; but I'm too lazy to do that, as one of the tests compares a
+ ;; list.)
+ (let* ((temp-dir (file-truename (make-temp-file "reftex-parse" 'dir)))
+ (tex-file (expand-file-name "test.tex" temp-dir))
+ (bib-file (expand-file-name "ref.bib" temp-dir)))
+ (with-temp-buffer
+ (insert
+"\\begin{document}
+\\section{test}\\label{sec:test}
+\\subsection{subtest}
+
+\\begin{align*}\\label{eq:foo}
+ x &= y^2
+\\end{align*}
+
+\\bibliographystyle{plain}
+\\bibliography{ref}
+\\end{document}")
+ (write-region (point-min) (point-max) tex-file))
+ (with-temp-buffer
+ (insert "test\n")
+ (write-region (point-min) (point-max) bib-file))
+ (reftex-ensure-compiled-variables)
+ (let ((parsed (reftex-parse-from-file tex-file nil temp-dir)))
+ (should (equal (car parsed) `(eof ,tex-file)))
+ (pop parsed)
+ (while parsed
+ (let ((entry (pop parsed)))
+ (cond
+ ((eq (car entry) 'bib)
+ (should (string= (cadr entry) bib-file)))
+ ((eq (car entry) 'toc)) ;; ...
+ ((string= (car entry) "eq:foo"))
+ ((string= (car entry) "sec:test"))
+ ((eq (car entry) 'bof)
+ (should (string= (cadr entry) tex-file))
+ (should (null parsed)))
+ (t (should-not t)))))
+ (delete-directory temp-dir 'recursive))))
+
+;;; reftex-cite
+(require 'reftex-cite)
+
+(ert-deftest reftex-parse-bibtex-entry-test ()
+ "Test `reftex-parse-bibtex-entry'."
+ (let ((entry "@Book{Stallman12,
+ author = {Richard Stallman\net al.},
+ title = {The Emacs Editor},
+ publisher = {GNU Press},
+ year = 2012,
+ edition = {17th},
+ note = {Updated for Emacs Version 24.2}
+}")
+ (check (function
+ (lambda (parsed)
+ (should (string= (reftex-get-bib-field "&key" parsed)
+ "Stallman12"))
+ (should (string= (reftex-get-bib-field "&type" parsed)
+ "book"))
+ (should (string= (reftex-get-bib-field "author" parsed)
+ "Richard Stallman et al."))
+ (should (string= (reftex-get-bib-field "title" parsed)
+ "The Emacs Editor"))
+ (should (string= (reftex-get-bib-field "publisher" parsed)
+ "GNU Press"))
+ (should (string= (reftex-get-bib-field "year" parsed)
+ "2012"))
+ (should (string= (reftex-get-bib-field "edition" parsed)
+ "17th"))
+ (should (string= (reftex-get-bib-field "note" parsed)
+ "Updated for Emacs Version 24.2"))))))
+ (funcall check (reftex-parse-bibtex-entry entry))
+ (with-temp-buffer
+ (insert entry)
+ (funcall check (reftex-parse-bibtex-entry nil (point-min)
+ (point-max))))))
+
+(ert-deftest reftex-get-bib-names-test ()
+ "Test `reftex-get-bib-names'."
+ (let ((entry (reftex-parse-bibtex-entry "@article{Foo123,
+ author = {Jane Roe and\tJohn Doe and W. Public},
+}")))
+ (should (equal (reftex-get-bib-names "author" entry)
+ '("Jane Roe" "John Doe" "Public"))))
+ (let ((entry (reftex-parse-bibtex-entry "@article{Foo123,
+ editor = {Jane Roe and\tJohn Doe and W. Public},
+}")))
+ (should (equal (reftex-get-bib-names "author" entry)
+ '("Jane Roe" "John Doe" "Public")))))
+
+(ert-deftest reftex-format-citation-test ()
+ "Test `reftex-format-citation'."
+ (let ((entry (reftex-parse-bibtex-entry
+"@article{Foo13,
+ author = {Jane Roe and John Doe and Jane Q. Taxpayer},
+ title = {Some Article},
+ journal = {Some Journal},
+ year = 2013,
+ pages = {1--333}
+}")))
+ (should (string= (reftex-format-citation entry nil) "\\cite{Foo13}"))
+ (should (string= (reftex-format-citation entry "%l:%A:%y:%t %j %P %a")
+ "Foo13:Jane Roe:2013:Some Article Some Journal 1 Jane Roe, John Doe \\& Jane Taxpayer"))))
+
+
+;;; Autoload tests
+
+;; Test to check whether reftex autoloading mechanisms are working
+;; correctly.
+(ert-deftest reftex-autoload-auc ()
+ "Tests to see whether reftex-auc has been autoloaded"
+ (should
+ (fboundp 'reftex-arg-label))
+ (should
+ (autoloadp
+ (symbol-function
+ 'reftex-arg-label))))
+
+
+(provide 'reftex-tests)
+;;; reftex-tests.el ends here.
diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el
new file mode 100644
index 00000000000..4184e2c3802
--- /dev/null
+++ b/test/lisp/textmodes/sgml-mode-tests.el
@@ -0,0 +1,135 @@
+;;; sgml-mode-tests.el --- Tests for sgml-mode
+
+;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
+
+;; Author: Przemysław Wojnowski <esperanto@cumego.com>
+;; Keywords: tests
+
+;; 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:
+
+;;; Code:
+
+(require 'sgml-mode)
+(require 'ert)
+
+(defmacro sgml-with-content (content &rest body)
+ "Insert CONTENT into a temporary `sgml-mode' buffer and execute BODY on it.
+The point is set to the beginning of the buffer."
+ `(with-temp-buffer
+ (sgml-mode)
+ (insert ,content)
+ (goto-char (point-min))
+ ,@body))
+
+;;; sgml-delete-tag
+
+(ert-deftest sgml-delete-tag-should-not-delete-tags-when-wrong-args ()
+ "Don't delete tag, when number of tags to delete is not positive number."
+ (let ((content "<p>Valar Morghulis</p>"))
+ (sgml-with-content
+ content
+ (sgml-delete-tag -1)
+ (should (string= content (buffer-string)))
+ (sgml-delete-tag 0)
+ (should (string= content (buffer-string))))))
+
+(ert-deftest sgml-delete-tag-should-delete-tags-n-times ()
+ ;; Delete only 1, when 1 available:
+ (sgml-with-content
+ "<br />"
+ (sgml-delete-tag 1)
+ (should (string= "" (buffer-string))))
+ ;; Delete from position on whitespaces before tag:
+ (sgml-with-content
+ " \t\n<br />"
+ (sgml-delete-tag 1)
+ (should (string= "" (buffer-string))))
+ ;; Delete from position on tag:
+ (sgml-with-content
+ "<br />"
+ (goto-char 3)
+ (sgml-delete-tag 1)
+ (should (string= "" (buffer-string))))
+ ;; Delete one by one:
+ (sgml-with-content
+ "<h1><p>You know nothing, Jon Snow.</p></h1>"
+ (sgml-delete-tag 1)
+ (should (string= "<p>You know nothing, Jon Snow.</p>" (buffer-string)))
+ (sgml-delete-tag 1)
+ (should (string= "You know nothing, Jon Snow." (buffer-string))))
+ ;; Delete 2 at a time, when 2 available:
+ (sgml-with-content
+ "<h1><p>You know nothing, Jon Snow.</p></h1>"
+ (sgml-delete-tag 2)
+ (should (string= "You know nothing, Jon Snow." (buffer-string)))))
+
+(ert-deftest sgml-delete-tag-should-delete-unclosed-tag ()
+ (sgml-with-content
+ "<ul><li>Keep your stones connected.</ul>"
+ (goto-char 5) ; position on "li" tag
+ (sgml-delete-tag 1)
+ (should (string= "<ul>Keep your stones connected.</ul>" (buffer-string)))))
+
+(ert-deftest sgml-delete-tag-should-signal-error-for-malformed-tags ()
+ (let ((content "<h1><h2>Drakaris!</h1></h2>"))
+ ;; Delete outside tag:
+ (sgml-with-content
+ content
+ (sgml-delete-tag 1)
+ (should (string= "<h2>Drakaris!</h2>" (buffer-string))))
+ ;; Delete inner tag:
+ (sgml-with-content
+ content
+ (goto-char 5) ; position the inner tag
+ (sgml-delete-tag 1)
+ (should (string= "<h1>Drakaris!</h1>" (buffer-string))))))
+
+(ert-deftest sgml-delete-tag-should-signal-error-when-deleting-too-much ()
+ (let ((content "<emph>Drakaris!</emph>"))
+ ;; No tags to delete:
+ (sgml-with-content
+ "Drakaris!"
+ (should-error (sgml-delete-tag 1) :type 'error)
+ (should (string= "Drakaris!" (buffer-string))))
+ ;; Trying to delete 2 tags, when only 1 available:
+ (sgml-with-content
+ content
+ (should-error (sgml-delete-tag 2) :type 'error)
+ (should (string= "Drakaris!" (buffer-string))))
+ ;; Trying to delete a tag, but not on/before a tag:
+ (sgml-with-content
+ content
+ (goto-char 7) ; D in Drakaris
+ (should-error (sgml-delete-tag 1) :type 'error)
+ (should (string= content (buffer-string))))
+ ;; Trying to delete a tag from position outside tag:
+ (sgml-with-content
+ content
+ (goto-char (point-max))
+ (should-error (sgml-delete-tag 1) :type 'error)
+ (should (string= content (buffer-string))))))
+
+(ert-deftest sgml-delete-tag-bug-8203-should-not-delete-apostrophe ()
+ :expected-result :failed
+ (sgml-with-content
+ "<title>Winter is comin'</title>"
+ (sgml-delete-tag 1)
+ (should (string= "Winter is comin'" (buffer-string)))))
+
+(provide 'sgml-mode-tests)
+;;; sgml-mode-tests.el ends here
diff --git a/test/lisp/textmodes/tildify-tests.el b/test/lisp/textmodes/tildify-tests.el
new file mode 100644
index 00000000000..8b50cf72868
--- /dev/null
+++ b/test/lisp/textmodes/tildify-tests.el
@@ -0,0 +1,264 @@
+;;; tildify-test.el --- ERT tests for tildify.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Michal Nazarewicz <mina86@mina86.com>
+;; Version: 4.5
+;; Keywords: text, TeX, SGML, wp
+
+;; 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:
+
+;; This package defines regression tests for the tildify package.
+
+;;; Code:
+
+(require 'ert)
+(require 'tildify)
+
+(defun tildify-test--example-sentence (space)
+ "Return an example sentence with SPACE where hard space is required."
+ (concat "Lorem ipsum v" space "dolor sit amet, a" space
+ "consectetur adipiscing elit."))
+
+
+(defun tildify-test--example-html (sentence &optional with-nbsp is-xml)
+ "Return an example HTML code.
+SENTENCE is placed where spaces should not be replaced with hard spaces, and
+WITH-NBSP is placed where spaces should be replaced with hard spaces. If the
+latter is missing, SENTENCE will be used in all placeholder positions.
+If IS-XML is non-nil, <pre> tag is not treated specially."
+ (let ((with-nbsp (or with-nbsp sentence)))
+ (concat "<p>" with-nbsp "</p>\n"
+ "<pre>" (if is-xml with-nbsp sentence) "</pre>\n"
+ "<! -- " sentence " -- >\n"
+ "<p>" with-nbsp "</p>\n"
+ "<" sentence ">\n")))
+
+
+(defun tildify-test--test (modes input expected)
+ "Test tildify running in MODES.
+INPUT is the initial content of the buffer and EXPECTED is expected result
+after `tildify-buffer' is run."
+ (with-temp-buffer
+ (setq-local buffer-file-coding-system 'utf-8)
+ (dolist (mode modes)
+ (erase-buffer)
+ (funcall mode)
+ (let ((header (concat "Testing `tildify-buffer' in "
+ (symbol-name mode) "\n")))
+ (insert header input)
+ (tildify-buffer t)
+ (should (string-equal (concat header expected) (buffer-string))))
+ (erase-buffer)
+ (let ((header (concat "Testing `tildify-region' in "
+ (symbol-name mode) "\n")))
+ (insert header input)
+ (tildify-region (point-min) (point-max) t)
+ (should (string-equal (concat header expected) (buffer-string)))))))
+
+(ert-deftest tildify-test-html ()
+ "Tests tildification in an HTML document"
+ (let* ((sentence (tildify-test--example-sentence " "))
+ (with-nbsp (tildify-test--example-sentence " ")))
+ (tildify-test--test '(html-mode sgml-mode)
+ (tildify-test--example-html sentence sentence)
+ (tildify-test--example-html sentence with-nbsp))))
+
+(ert-deftest tildify-test-xml ()
+ "Tests tildification in an XML document"
+ (let* ((sentence (tildify-test--example-sentence " "))
+ (with-nbsp (tildify-test--example-sentence " ")))
+ (tildify-test--test '(nxml-mode)
+ (tildify-test--example-html sentence sentence t)
+ (tildify-test--example-html sentence with-nbsp t))))
+
+
+(defun tildify-test--example-tex (sentence &optional with-nbsp)
+ "Return an example (La)Tex code.
+SENTENCE is placed where spaces should not be replaced with hard spaces, and
+WITH-NBSP is placed where spaces should be replaced with hard spaces. If the
+latter is missing, SENTENCE will be used in all placeholder positions."
+ (let ((with-nbsp (or with-nbsp sentence)))
+ (concat with-nbsp "\n"
+ "\\begin{verbatim}\n" sentence "\n\\end{verbatim}\n"
+ "\\verb#" sentence "#\n"
+ "$$" sentence "$$\n"
+ "$" sentence "$\n"
+ "\\[" sentence "\\]\n"
+ "\\v A % " sentence "\n"
+ with-nbsp "\n")))
+
+(ert-deftest tildify-test-tex ()
+ "Tests tildification in a (La)TeX document"
+ (let* ((sentence (tildify-test--example-sentence " "))
+ (with-nbsp (tildify-test--example-sentence "~")))
+ (tildify-test--test '(tex-mode latex-mode plain-tex-mode)
+ (tildify-test--example-tex sentence sentence)
+ (tildify-test--example-tex sentence with-nbsp))))
+
+
+(ert-deftest tildify-test-find-env-end-re-bug ()
+ "Tests generation of end-regex using mix of indexes and strings"
+ (with-temp-buffer
+ (insert "foo whatever end-foo")
+ (goto-char (point-min))
+ (should (string-equal "end-foo"
+ (tildify--find-env "foo\\|bar"
+ '(("foo\\|bar" . ("end-" 0))))))))
+
+
+(ert-deftest tildify-test-find-env-group-index-bug ()
+ "Tests generation of match-string indexes"
+ (with-temp-buffer
+ (let ((pairs '(("start-\\(foo\\|bar\\)" . ("end-" 1))
+ ("open-\\(foo\\|bar\\)" . ("close-" 1))))
+ (beg-re "start-\\(foo\\|bar\\)\\|open-\\(foo\\|bar\\)"))
+ (insert "open-foo whatever close-foo")
+ (goto-char (point-min))
+ (should (string-equal "close-foo" (tildify--find-env beg-re pairs))))))
+
+
+(defmacro with-test-foreach (expected &rest body)
+ "Helper macro for testing foreach functions.
+BODY has access to pairs variable and called lambda."
+ (declare (indent 1))
+ (let ((got (make-symbol "got")))
+ `(with-temp-buffer
+ (insert "1 /- 2 -/ 3 V~ 4 ~ 5 /- 6 -/ 7")
+ (let* ((pairs '(("/-" . "-/") ("V\\(.\\)" . (1))))
+ (,got "")
+ (called (lambda (s e)
+ (setq ,got (concat ,got (buffer-substring s e))))))
+ (setq-local tildify-foreach-region-function
+ (apply-partially 'tildify-foreach-ignore-environments
+ pairs))
+ ,@body
+ (should (string-equal ,expected ,got))))))
+
+(ert-deftest tildify-test-foreach-ignore-environments ()
+ "Basic test of `tildify-foreach-ignore-environments'"
+ (with-test-foreach "1 3 5 7"
+ (tildify-foreach-ignore-environments pairs called (point-min) (point-max))))
+
+
+(ert-deftest tildify-test-foreach-ignore-environments-early-return ()
+ "Test whether `tildify-foreach-ignore-environments' returns early
+The function must terminate as soon as callback returns nil."
+ (with-test-foreach "1 "
+ (tildify-foreach-ignore-environments
+ pairs (lambda (start end) (funcall called start end) nil)
+ (point-min) (point-max))))
+
+(ert-deftest tildify-test-foreach-region ()
+ "Basic test of `tildify--foreach-region'"
+ (with-test-foreach "1 3 5 7"
+ (tildify--foreach-region called (point-min) (point-max))))
+
+(ert-deftest tildify-test-foreach-region-early-return ()
+ "Test whether `tildify--foreach-ignore' returns early
+The function must terminate as soon as callback returns nil."
+ (with-test-foreach "1 "
+ (tildify--foreach-region (lambda (start end) (funcall called start end) nil)
+ (point-min) (point-max))))
+
+(ert-deftest tildify-test-foreach-region-limit-region ()
+ "Test whether `tildify--foreach-ignore' limits callback to given region"
+ (with-test-foreach "3 "
+ (tildify--foreach-region called
+ (+ (point-min) 10) (+ (point-min) 16))) ; start at "3" end past "4"
+ (with-test-foreach "3 5"
+ (tildify--foreach-region called
+ (+ (point-min) 10) (+ (point-min) 20)))) ; start at "3" end past "5"
+
+
+(defun tildify-space-test--test (modes nbsp env-open &optional set-space-string)
+ (with-temp-buffer
+ (setq-local buffer-file-coding-system 'utf-8)
+ (dolist (mode modes)
+ (funcall mode)
+ (when set-space-string
+ (setq-local tildify-space-string nbsp))
+ (let ((header (concat "Testing `tildify-space' in "
+ (symbol-name mode) "\n")))
+ ;; Replace space with hard space.
+ (erase-buffer)
+ (insert header "Lorem v ")
+ (should (tildify-space))
+ (should (string-equal (concat header "Lorem v" nbsp) (buffer-string)))
+ ;; Inside and ignore environment, replacing does not happen.
+ (erase-buffer)
+ (insert header env-open "Lorem v ")
+ (should (not (tildify-space)))
+ (should (string-equal (concat header env-open "Lorem v ")
+ (buffer-string)))))))
+
+(ert-deftest tildify-space-test-html ()
+ "Tests auto-tildification in an HTML document"
+ (tildify-space-test--test '(html-mode sgml-mode) " " "<pre>"))
+
+(ert-deftest tildify-space-test-html-nbsp ()
+ "Tests auto-tildification in an HTML document"
+ (tildify-space-test--test '(html-mode sgml-mode) "&nbsp;" "<pre>" t))
+
+(ert-deftest tildify-space-test-xml ()
+ "Tests auto-tildification in an XML document"
+ (tildify-space-test--test '(nxml-mode) " " "<! -- "))
+
+(ert-deftest tildify-space-test-tex ()
+ "Tests tildification in a TeX document"
+ (tildify-space-test--test '(tex-mode latex-mode plain-tex-mode)
+ "~" "\\verb# "))
+
+
+(defun tildify-space-undo-test--test
+ (modes nbsp env-open &optional set-space-string)
+ (with-temp-buffer
+ (setq-local buffer-file-coding-system 'utf-8)
+ (dolist (mode modes)
+ (funcall mode)
+ (when set-space-string
+ (setq-local tildify-space-string nbsp))
+ (let ((header (concat "Testing double-space-undos in "
+ (symbol-name mode) "\n")))
+ (erase-buffer)
+ (insert header "Lorem v" nbsp " ")
+ (should (not (tildify-space)))
+ (should (string-equal (concat header "Lorem v ") (buffer-string)))))))
+
+(ert-deftest tildify-space-undo-test-html ()
+ "Tests auto-tildification in an HTML document"
+ (tildify-space-undo-test--test '(html-mode sgml-mode) " " "<pre>"))
+
+(ert-deftest tildify-space-undo-test-html-nbsp ()
+ "Tests auto-tildification in an HTML document"
+ (tildify-space-undo-test--test '(html-mode sgml-mode) "&nbsp;" "<pre>" t))
+
+(ert-deftest tildify-space-undo-test-xml ()
+ "Tests auto-tildification in an XML document"
+ (tildify-space-undo-test--test '(nxml-mode) " " "<! -- "))
+
+(ert-deftest tildify-space-undo-test-tex ()
+ "Tests tildification in a TeX document"
+ (tildify-space-undo-test--test '(tex-mode latex-mode plain-tex-mode)
+ "~" "\\verb# "))
+
+
+
+(provide 'tildify-tests)
+
+;;; tildify-tests.el ends here