From ed4281ff072443167c43207c039570126061d23b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 12 Apr 2022 13:30:32 +0200
Subject: Add a lot of new unit tests.

---
 tests/test/html/component.scm | 59 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)
 create mode 100644 tests/test/html/component.scm

(limited to 'tests/test/html/component.scm')

diff --git a/tests/test/html/component.scm b/tests/test/html/component.scm
new file mode 100644
index 00000000..97581c50
--- /dev/null
+++ b/tests/test/html/component.scm
@@ -0,0 +1,59 @@
+(define-module (test html caltable)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-64 test-error)
+  :use-module (srfi srfi-88)
+  :use-module (calp translation)
+
+  :use-module (calp html components)
+  )
+
+(test-equal '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                    (html (@ (xmlns "http://www.w3.org/1999/xhtml"))
+                          body))
+  (xhtml-doc body))
+
+(test-equal '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                    (html (@ (xmlns "http://www.w3.org/1999/xhtml"))
+                          (b "Hello, World!")))
+  (xhtml-doc ,'(b "Hello, World!")))
+
+(test-equal
+    '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+            (html (@ (xmlns "http://www.w3.org/1999/xhtml")
+                     (lang sv))
+                  body))
+    (xhtml-doc (@ (lang sv)) body))
+
+
+;; TODO Slider not tested, due to depending on gensyms, and really needing
+;;      integration testing to be worth anything.
+
+
+(test-equal
+    '(button (@ (class "btn") (onclick "onclick")) "Body")
+  (btn onclick: "onclick" "Body"))
+
+(test-equal "href button, without body"
+    '(a (@ (class "btn") (href "href")) #f)
+  (btn href: "href"))
+
+(test-error 'wrong-type-arg
+  (btn href: "a" onclick: "b"))
+
+(test-equal "btn no specifier, but class"
+  '(button (@ (class "btn test")) "body")
+  (btn class: '("test") "body"))
+
+;; tabset
+;; with-label
+
+(test-equal '(link (@ (type "text/css") (rel "stylesheet") (href "style.css")))
+  (include-css "style.css"))
+
+(test-equal
+    '(link (@ (type "text/css") (rel "stylesheet") (href "style.css") (class "test")))
+  (include-css "style.css" '(class "test")))
+
+(test-equal
+    '(link (@ (type "text/css") (rel "alternate stylesheet") (href "style.css")))
+  (include-alt-css "style.css"))
-- 
cgit v1.2.3