unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#24313: [PATCH] Add tests for dom.el
@ 2016-08-26 18:26 Simen Heggestøyl
  2016-08-27  8:18 ` Eli Zaretskii
                   ` (2 more replies)
  0 siblings, 3 replies; 8+ messages in thread
From: Simen Heggestøyl @ 2016-08-26 18:26 UTC (permalink / raw)
  To: larsi; +Cc: 24313

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

Hello,

I saw that dom.el didn't have any tests, so I wrote some.

Do they look okay to add?

-- Simen

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-tests-for-dom.el.patch --]
[-- Type: text/x-patch, Size: 8066 bytes --]

From c74c0fac972ce235954efc56ff540021f9dd0615 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= <simenheg@gmail.com>
Date: Sun, 14 Aug 2016 16:03:50 +0200
Subject: [PATCH] Add tests for dom.el

* test/lisp/dom-tests.el: New file with tests for dom.el.
---
 test/lisp/dom-tests.el | 195 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 195 insertions(+)
 create mode 100644 test/lisp/dom-tests.el

diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
new file mode 100644
index 0000000..e3e14b2
--- /dev/null
+++ b/test/lisp/dom-tests.el
@@ -0,0 +1,195 @@
+;;; dom-tests.el --- Tests for dom.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; 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 'dom)
+(require 'ert)
+(require 'subr-x)
+
+(defun dom-test-tree ()
+  "Return a DOM tree for testing."
+  (dom-node "html" nil
+            (dom-node "head" nil
+                      (dom-node "title" nil
+                                "Test"))
+            (dom-node "body" nil
+                      (dom-node "div" '((class . "foo")
+                                        (style . "color: red;"))
+                                (dom-node "p" '((id . "bar"))
+                                          "foo"))
+                      (dom-node "div" '((title . "2nd div"))
+                                "bar"))))
+
+(ert-deftest test-dom-tag ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-tag dom) "html"))
+    (should (equal (dom-tag (car (dom-children dom))) "head"))))
+
+(ert-deftest test-dom-attributes ()
+  (let ((dom (dom-test-tree)))
+    (should (null (dom-attributes dom)))
+    (should (equal (dom-attributes (dom-by-class dom "foo"))
+                   '((class . "foo") (style . "color: red;"))))))
+
+(ert-deftest test-dom-children ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (mapcar #'dom-tag (dom-children dom))
+                   '("head" "body")))
+    (should (equal (dom-tag (dom-children (dom-children dom)))
+                   "title"))))
+
+(ert-deftest test-dom-non-text-children ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-children dom) (dom-non-text-children dom)))
+    (should (null (dom-non-text-children
+                   (dom-children (dom-children dom)))))))
+
+(ert-deftest test-dom-set-attributes ()
+  (let ((dom (dom-test-tree))
+        (attributes '((xmlns "http://www.w3.org/1999/xhtml"))))
+    (should (null (dom-attributes dom)))
+    (dom-set-attributes dom attributes)
+    (should (equal (dom-attributes dom) attributes))))
+
+(ert-deftest test-dom-set-attribute ()
+  (let ((dom (dom-test-tree))
+        (attr 'xmlns)
+        (value "http://www.w3.org/1999/xhtml"))
+    (should (null (dom-attributes dom)))
+    (dom-set-attribute dom attr value)
+    (should (equal (dom-attr dom attr) value))))
+
+(ert-deftest test-dom-attr ()
+  (let ((dom (dom-test-tree)))
+    (should (null (dom-attr dom 'id)))
+    (should (equal (dom-attr (dom-by-id dom "bar") 'id) "bar"))))
+
+(ert-deftest test-dom-text ()
+  (let ((dom (dom-test-tree)))
+    (should (string-empty-p (dom-text dom)))
+    (should (equal (dom-text (dom-by-tag dom "title")) "Test"))))
+
+(ert-deftest test-dom-texts ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-texts dom) "Test foo bar"))
+    (should (equal (dom-texts dom ", ") "Test, foo, bar"))))
+
+(ert-deftest test-dom-child-by-tag ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-child-by-tag dom "head")
+                   (car (dom-children dom))))
+    (should (not (dom-child-by-tag dom "title")))))
+
+(ert-deftest test-dom-by-tag ()
+  (let ((dom (dom-test-tree)))
+    (should (= (length (dom-by-tag dom "div")) 2))
+    (should (null (dom-by-tag dom "article")))))
+
+(ert-deftest test-dom-strings ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-strings dom) '("Test" "foo" "bar")))
+    (should (equal (dom-strings (dom-children dom)) '("Test")))))
+
+(ert-deftest test-dom-by-class ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-tag (dom-by-class dom "foo")) "div"))
+    (should (null (dom-by-class dom "bar")))))
+
+(ert-deftest test-dom-by-style ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-tag (dom-by-style dom "color")) "div"))
+    (should (null (dom-by-style dom "width")))))
+
+(ert-deftest test-dom-by-id ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-tag (dom-by-id dom "bar")) "p"))
+    (should (null (dom-by-id dom "foo")))))
+
+(ert-deftest test-dom-elements ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (dom-elements dom 'class "foo")
+                   (dom-by-class dom "foo")))
+    (should (equal (dom-attr (dom-elements dom 'title "2nd") 'title)
+                   "2nd div"))))
+
+(ert-deftest test-dom-remove-node ()
+  (let ((dom (dom-test-tree)))
+    (should (not (dom-remove-node dom dom)))
+    (should (= (length (dom-children dom)) 2))
+    (dom-remove-node dom (car (dom-children dom)))
+    (should (= (length (dom-children dom)) 1))
+    (dom-remove-node dom (car (dom-children dom)))
+    (should (null (dom-children dom)))))
+
+(ert-deftest test-dom-parent ()
+  (let ((dom (dom-test-tree)))
+    (should (not (dom-parent dom dom)))
+    (should (equal (dom-parent dom (car (dom-children dom))) dom))))
+
+(ert-deftest test-dom-previous-sibling ()
+  (let ((dom (dom-test-tree)))
+    (should (not (dom-previous-sibling dom dom)))
+    (let ((children (dom-children dom)))
+      (should (equal (dom-previous-sibling dom (cadr children))
+                     (car children))))))
+
+(ert-deftest test-dom-append-child ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (mapcar #'dom-tag (dom-children dom))
+                   '("head" "body")))
+    (dom-append-child dom (dom-node "feet"))
+    (should (equal (mapcar #'dom-tag (dom-children dom))
+                   '("head" "body" "feet")))))
+
+(ert-deftest test-dom-add-child-before ()
+  (let ((dom (dom-test-tree)))
+    (should (equal (mapcar #'dom-tag (dom-children dom))
+                   '("head" "body")))
+    (dom-add-child-before dom (dom-node "neck")
+                          (dom-child-by-tag dom "body"))
+    (should (equal (mapcar #'dom-tag (dom-children dom))
+                   '("head" "neck" "body")))
+    (dom-add-child-before dom (dom-node "hat"))
+    (should (equal (mapcar #'dom-tag (dom-children dom))
+                   '("hat" "head" "neck" "body")))))
+
+(ert-deftest test-dom-ensure-node ()
+  (let ((node (dom-node "foo")))
+    (should (equal (dom-ensure-node '("foo")) node))
+    (should (equal (dom-ensure-node '(("foo"))) node))
+    (should (equal (dom-ensure-node '("foo" nil)) node))
+    (should (equal (dom-ensure-node '(("foo") nil)) node))))
+
+(ert-deftest test-dom-pp ()
+  (let ((node (dom-node "foo" nil "")))
+    (with-temp-buffer
+      (dom-pp node)
+      (should (equal (buffer-string) "(\"foo\" nil\n \"\")")))
+    (with-temp-buffer
+      (dom-pp node t)
+      (should (equal (buffer-string) "(\"foo\" nil)")))))
+
+(provide 'dom-tests)
+;;; dom-tests.el ends here
-- 
2.9.3


^ permalink raw reply related	[flat|nested] 8+ messages in thread
end of thread, other threads:[~2016-08-28 17:41 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-08-26 18:26 bug#24313: [PATCH] Add tests for dom.el Simen Heggestøyl
2016-08-27  8:18 ` Eli Zaretskii
2016-08-27 10:07 ` Michael Albinus
2016-08-27 13:46 ` Lars Ingebrigtsen
2016-08-28  8:58   ` Simen Heggestøyl
2016-08-28  9:21     ` Michael Albinus
2016-08-28 16:38       ` Simen Heggestøyl
2016-08-28 17:41         ` Michael Albinus

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).