236 lines
8.1 KiB
EmacsLisp
236 lines
8.1 KiB
EmacsLisp
;;; sgml-mode-tests.el --- Tests for sgml-mode -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2015-2024 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 <https://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 ()
|
|
(sgml-with-content
|
|
"<title>Winter is comin'</title>"
|
|
(sgml-delete-tag 1)
|
|
(should (string= "Winter is comin'" (buffer-string)))))
|
|
|
|
(ert-deftest sgml-quote-works ()
|
|
(let ((text "Foo<Bar> \"Baz\" 'Qux'\n"))
|
|
(with-temp-buffer
|
|
;; Back and forth transformation.
|
|
(insert text)
|
|
(sgml-quote (point-min) (point-max))
|
|
(should (string= "Foo<Bar> "Baz" 'Qux'\n"
|
|
(buffer-string)))
|
|
(sgml-quote (point-min) (point-max) t)
|
|
(should (string= text (buffer-string)))
|
|
|
|
;; The same text escaped differently.
|
|
(erase-buffer)
|
|
(insert "Foo<Bar> "Baz" 'Qux'\n")
|
|
(sgml-quote (point-min) (point-max) t)
|
|
(should (string= text (buffer-string)))
|
|
|
|
;; Lack of semicolon.
|
|
(erase-buffer)
|
|
(insert "&&")
|
|
(sgml-quote (point-min) (point-max) t)
|
|
(should (string= "&&" (buffer-string)))
|
|
|
|
;; Double quoting
|
|
(sgml-quote (point-min) (point-max))
|
|
(sgml-quote (point-min) (point-max))
|
|
(sgml-quote (point-min) (point-max) t)
|
|
(sgml-quote (point-min) (point-max) t)
|
|
(should (string= "&&" (buffer-string))))))
|
|
|
|
(ert-deftest sgml-tests--quotes-syntax ()
|
|
(dolist (str '("a\"b <t>c'd</t>"
|
|
"a'b <t>c\"d</t>"
|
|
"<t>\"a'</t>"
|
|
"<t>'a\"</t>"
|
|
"<t>\"a'\"</t>"
|
|
"<t>'a\"'</t>"
|
|
"a\"b <tag>c'd</tag>"
|
|
"<tag>c>'d</tag>"
|
|
"<t><!-- \" --></t>"
|
|
"<t><!-- ' --></t>"
|
|
"<t>(')</t>"
|
|
"<t>(\")</t>"
|
|
))
|
|
(with-temp-buffer
|
|
(sgml-mode)
|
|
(insert str)
|
|
(ert-info ((format "%S" str) :prefix "Test case: ")
|
|
;; Check that last tag is parsed as a tag.
|
|
(should (= 1 (car (syntax-ppss (1- (point-max))))))
|
|
(should (= 0 (car (syntax-ppss (point-max)))))))))
|
|
|
|
(ert-deftest sgml-mode-quote-in-long-text ()
|
|
(with-temp-buffer
|
|
(sgml-mode)
|
|
(insert "<t>"
|
|
;; `syntax-propertize-wholelines' extends chunk size based
|
|
;; on line length, so newlines are significant!
|
|
(make-string syntax-propertize-chunk-size ?a) "\n"
|
|
"'"
|
|
(make-string syntax-propertize-chunk-size ?a) "\n"
|
|
"</t>")
|
|
;; If we just check (syntax-ppss (point-max)) immediately, then
|
|
;; we'll end up propertizing the whole buffer in one chunk (so the
|
|
;; test is useless). Simulate something more like what happens
|
|
;; when the buffer is viewed normally.
|
|
(cl-loop for pos from (point-min) to (point-max)
|
|
by syntax-propertize-chunk-size
|
|
do (syntax-ppss pos))
|
|
(syntax-ppss (point-max))
|
|
;; Check that last tag is parsed as a tag.
|
|
(should (= 1 (- (car (syntax-ppss (1- (point-max))))
|
|
(car (syntax-ppss (point-max))))))))
|
|
|
|
(ert-deftest sgml-test-brackets ()
|
|
"Test fontification of apostrophe preceded by paired-bracket character."
|
|
(let (brackets)
|
|
(map-char-table
|
|
(lambda (key value)
|
|
(setq brackets (cons (list
|
|
(if (consp key)
|
|
(list (car key) (cdr key))
|
|
key)
|
|
value)
|
|
brackets)))
|
|
(unicode-property-table-internal 'paired-bracket))
|
|
(setq brackets (delete-dups (flatten-tree brackets)))
|
|
(setq brackets (append brackets (list ?$ ?% ?& ?* ?+ ?/)))
|
|
(with-temp-buffer
|
|
(while brackets
|
|
(let ((char (string (pop brackets))))
|
|
(insert (concat "<p>" char "'s</p>\n"))))
|
|
(html-mode)
|
|
(font-lock-ensure (point-min) (point-max))
|
|
(goto-char (point-min))
|
|
(while (not (eobp))
|
|
(goto-char (next-single-char-property-change (point) 'face))
|
|
(let ((val (get-text-property (point) 'face)))
|
|
(when val
|
|
(should-not (eq val 'font-lock-string-face))))))))
|
|
|
|
(provide 'sgml-mode-tests)
|
|
;;; sgml-mode-tests.el ends here
|