test/lisp/dom-tests.el

   1 ;;; dom-tests.el --- Tests for dom.el  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2016-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Simen Heggestøyl <simenheg@gmail.com>
   6 ;; Keywords:
   7
   8 ;; GNU Emacs is free software: you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;;
  24
  25 ;;; Code:
  26
  27 (require 'dom)
  28 (require 'ert)
  29
  30 ;; `defsubst's are not inlined inside `ert-deftest' (see Bug#24402),
  31 ;; therefore we can't use `eval-when-compile' here.
  32 (require 'subr-x)
  33
  34 (defun dom-tests--tree ()
  35   "Return a DOM tree for testing."
  36   (dom-node "html" nil
  37             (dom-node "head" nil
  38                       (dom-node "title" nil
  39                                 "Test"))
  40             (dom-node "body" nil
  41                       (dom-node "div" '((class . "foo")
  42                                         (style . "color: red;"))
  43                                 (dom-node "p" '((id . "bar"))
  44                                           "foo"))
  45                       (dom-node "div" '((title . "2nd div"))
  46                                 "bar"))))
  47
  48 (ert-deftest dom-tests-tag ()
  49   (let ((dom (dom-tests--tree)))
  50     (should (equal (dom-tag dom) "html"))
  51     (should (equal (dom-tag (car (dom-children dom))) "head"))))
  52
  53 (ert-deftest dom-tests-attributes ()
  54   (let ((dom (dom-tests--tree)))
  55     (should-not (dom-attributes dom))
  56     (should (equal (dom-attributes (dom-by-class dom "foo"))
  57                    '((class . "foo") (style . "color: red;"))))))
  58
  59 (ert-deftest dom-tests-children ()
  60   (let ((dom (dom-tests--tree)))
  61     (should (equal (mapcar #'dom-tag (dom-children dom))
  62                    '("head" "body")))
  63     (should (equal (dom-tag (dom-children (dom-children dom)))
  64                    "title"))))
  65
  66 (ert-deftest dom-tests-non-text-children ()
  67   (let ((dom (dom-tests--tree)))
  68     (should (equal (dom-children dom) (dom-non-text-children dom)))
  69     (should-not (dom-non-text-children
  70                  (dom-children (dom-children dom))))))
  71
  72 (ert-deftest dom-tests-set-attributes ()
  73   (let ((dom (dom-tests--tree))
  74         (attributes '((xmlns "http://www.w3.org/1999/xhtml"))))
  75     (should-not (dom-attributes dom))
  76     (dom-set-attributes dom attributes)
  77     (should (equal (dom-attributes dom) attributes))))
  78
  79 (ert-deftest dom-tests-set-attribute ()
  80   (let ((dom (dom-tests--tree))
  81         (attr 'xmlns)
  82         (value "http://www.w3.org/1999/xhtml"))
  83     (should-not (dom-attributes dom))
  84     (dom-set-attribute dom attr value)
  85     (should (equal (dom-attr dom attr) value))))
  86
  87 (ert-deftest dom-tests-attr ()
  88   (let ((dom (dom-tests--tree)))
  89     (should-not (dom-attr dom 'id))
  90     (should (equal (dom-attr (dom-by-id dom "bar") 'id) "bar"))))
  91
  92 (ert-deftest dom-tests-text ()
  93   (let ((dom (dom-tests--tree)))
  94     (should (string-empty-p (dom-text dom)))
  95     (should (equal (dom-text (dom-by-tag dom "title")) "Test"))))
  96
  97 (ert-deftest dom-tests-texts ()
  98   (let ((dom (dom-tests--tree)))
  99     (should (equal (dom-texts dom) "Test foo bar"))
 100     (should (equal (dom-texts dom ", ") "Test, foo, bar"))))
 101
 102 (ert-deftest dom-tests-child-by-tag ()
 103   (let ((dom (dom-tests--tree)))
 104     (should (equal (dom-child-by-tag dom "head")
 105                    (car (dom-children dom))))
 106     (should-not (dom-child-by-tag dom "title"))))
 107
 108 (ert-deftest dom-tests-by-tag ()
 109   (let ((dom (dom-tests--tree)))
 110     (should (= (length (dom-by-tag dom "div")) 2))
 111     (should-not (dom-by-tag dom "article"))))
 112
 113 (ert-deftest dom-tests-strings ()
 114   (let ((dom (dom-tests--tree)))
 115     (should (equal (dom-strings dom) '("Test" "foo" "bar")))
 116     (should (equal (dom-strings (dom-children dom)) '("Test")))))
 117
 118 (ert-deftest dom-tests-by-class ()
 119   (let ((dom (dom-tests--tree)))
 120     (should (equal (dom-tag (dom-by-class dom "foo")) "div"))
 121     (should-not (dom-by-class dom "bar"))))
 122
 123 (ert-deftest dom-tests-by-style ()
 124   (let ((dom (dom-tests--tree)))
 125     (should (equal (dom-tag (dom-by-style dom "color")) "div"))
 126     (should-not (dom-by-style dom "width"))))
 127
 128 (ert-deftest dom-tests-by-id ()
 129   (let ((dom (dom-tests--tree)))
 130     (should (equal (dom-tag (dom-by-id dom "bar")) "p"))
 131     (should-not (dom-by-id dom "foo"))))
 132
 133 (ert-deftest dom-tests-elements ()
 134   (let ((dom (dom-tests--tree)))
 135     (should (equal (dom-elements dom 'class "foo")
 136                    (dom-by-class dom "foo")))
 137     (should (equal (dom-attr (dom-elements dom 'title "2nd") 'title)
 138                    "2nd div"))))
 139
 140 (ert-deftest dom-tests-remove-node ()
 141   (let ((dom (dom-tests--tree)))
 142     (should-not (dom-remove-node dom dom))
 143     (should (= (length (dom-children dom)) 2))
 144     (dom-remove-node dom (car (dom-children dom)))
 145     (should (= (length (dom-children dom)) 1))
 146     (dom-remove-node dom (car (dom-children dom)))
 147     (should-not (dom-children dom))))
 148
 149 (ert-deftest dom-tests-parent ()
 150   (let ((dom (dom-tests--tree)))
 151     (should-not (dom-parent dom dom))
 152     (should (equal (dom-parent dom (car (dom-children dom))) dom))))
 153
 154 (ert-deftest dom-tests-previous-sibling ()
 155   (let ((dom (dom-tests--tree)))
 156     (should-not (dom-previous-sibling dom dom))
 157     (let ((children (dom-children dom)))
 158       (should (equal (dom-previous-sibling dom (cadr children))
 159                      (car children))))))
 160
 161 (ert-deftest dom-tests-append-child ()
 162   (let ((dom (dom-tests--tree)))
 163     (should (equal (mapcar #'dom-tag (dom-children dom))
 164                    '("head" "body")))
 165     (dom-append-child dom (dom-node "feet"))
 166     (should (equal (mapcar #'dom-tag (dom-children dom))
 167                    '("head" "body" "feet")))))
 168
 169 (ert-deftest dom-tests-add-child-before ()
 170   "Test `dom-add-child-before'.
 171 Tests the cases of adding a new first-child and mid-child.  Also
 172 checks that an attempt to add a new node before a non-existent
 173 child results in an error."
 174   (let ((dom (dom-tests--tree)))
 175     (should (equal (mapcar #'dom-tag (dom-children dom))
 176                    '("head" "body")))
 177     (dom-add-child-before dom (dom-node "neck")
 178                           (dom-child-by-tag dom "body"))
 179     (should (equal (mapcar #'dom-tag (dom-children dom))
 180                    '("head" "neck" "body")))
 181     (dom-add-child-before dom (dom-node "hat"))
 182     (should (equal (mapcar #'dom-tag (dom-children dom))
 183                    '("hat" "head" "neck" "body")))
 184     (should-error (dom-add-child-before dom (dom-node "neck")
 185                                         (dom-by-id dom "bar")))))
 186
 187 (ert-deftest dom-tests-ensure-node ()
 188   (let ((node (dom-node "foo")))
 189     (should (equal (dom-ensure-node '("foo")) node))
 190     (should (equal (dom-ensure-node '(("foo"))) node))
 191     (should (equal (dom-ensure-node '("foo" nil)) node))
 192     (should (equal (dom-ensure-node '(("foo") nil)) node))))
 193
 194 (ert-deftest dom-tests-pp ()
 195   (let ((node (dom-node "foo" nil "")))
 196     (with-temp-buffer
 197       (dom-pp node)
 198       (should (equal (buffer-string) "(\"foo\" nil\n \"\")")))
 199     (with-temp-buffer
 200       (dom-pp node t)
 201       (should (equal (buffer-string) "(\"foo\" nil)")))))
 202
 203 (provide 'dom-tests)
 204 ;;; dom-tests.el ends here